我有一个包含大量数据(气象站目录)的电子表格,它可以计算用户输入的纬度和经度最近的气象站 . 此工作表通过计算距离输入点的距离,使用SMALL()对这些距离进行排名,然后使用公式执行索引(匹配())类型计算的excel TABLE / List(使用排名(1最接近,2是第2最接近等)来实现此目的 .
工作表虽然很慢,但工作得相当好 - 而excel Tables允许按照各种标准(例如年份记录的长度等)对气象站目录进行高级分类 .
我有一个VBA宏,我写的曾经工作,但当我试图修复它时停止工作(太棒了) .
VBA宏的目的是编写带有纬度/长度/气象站名称的Google Earth KML文件,然后将该文件启动到Google地球中,以便用户可以看到设置站点位置周围的邻近站点(之前输入的站点)由用户) .
不幸的是,我使用的原始方法无法处理列表的过滤结果,因此如果用户过滤了结果(例如,前4个气象站被过滤掉了)宏仍然会编写前四个气象站那些不可见/被过滤的 .
对我来说问题变得更加困难,因为我希望只有一个宏用于具有可过滤表的四个工作表 - 用于不同的数据类型 .
在此阶段,宏需要的数据存储在表中,名称相同的表格列:{“STATION”,“LONGITUDE”,“LATITUDE”}在不同的工作表中 . 写入KML文件所需的大多数KML字符串存储在另一个隐藏的工作表“KML”中 .
通过每个页面上的按钮启动宏 .
我知道可能有一个使用“.SpecialCells(xlCellTypeVisible)”的解决方案 - 我已经尝试过广泛使用它来使用我的表 - 但到目前为止没有运气 - 可能是由于我缺乏正式的培训 .
任何帮助表示赞赏,无论是解决方案还是建议!我的错误代码道歉,问题循环和破损的代码区域大约有一半 - 在'查找活动表上的所有表格后:
Sub KML_writer()
Dim FileName As String
Dim StrA As String
Dim NumberOfKMLs
Dim MsgBoxResponse
Dim MsgBoxTitle
Dim MsgBoxPrompt
Dim WhileCounter
Dim oSh As Worksheet
Set oSh = ActiveSheet
'Prompt the Number of Stations to Write to the KML File
NumberOfKMLs = InputBox(Prompt:="Please Enter the number of Weather Stations to generate within the Google Earth KML file", _
Title:="Number of Weather Stations", Default:="10")
'Prompt a File Name
FileName = InputBox(Prompt:="Please Enter a name for your KML File.", _
Title:="Lat Long to KML Converter", Default:="ENTER FILE NAME")
'Will clean this up to not require Write to Cell and Write to KML duplication later
Sheets("kml").Range("B3").Value = FileName
Sheets("mrg").Range("C5").Value = "Exported from EXCEL by AJK's MRG Function"
saveDir = "H:\" 'Local Drive available for all users of macro
targetfile = saveDir & FileName & ".KML"
'Write Site Location to KML STRING - user entered values from SITE LOCATION worksheet
StrA = Sheets("kml").Range("B1").Value & Sheets("kml").Range("B2").Value & "SITE LOCATION" & Sheets("kml").Range("B4").Value & Sheets("INPUT COORDINATES").Range("E5").Value & Sheets("kml").Range("B6").Value & Sheets("INPUT COORDINATES").Range("E4").Value & Sheets("kml").Range("B8").Value
'Find all tables on active sheet
Dim oLo As ListObject
For Each oLo In oSh.ListObjects
'
Dim lo As Excel.ListObject
Dim lr As Excel.ListRow
Set lo = oSh.ListObjects(oLo.Name)
Dim cl As Range, rng As Range
Set rng = Range(lo.ListRows(1)) 'this is where it breaks currently
For Each cl In rng2 '.SpecialCells(xlCellTypeVisible)
'Stop looping when NumberofKMLs is written to KML
WhileCounter = 0
Do Until WhileCounter > (NumberOfKMLs - 1)
WhileCounter = WhileCounter + 1
Dim St
Dim La
Dim Lon
'Store the lr.Range'th station data to write to the KML
St = Intersect(lr.Range, lo.ListColumns("STATION").Range).Value
La = Intersect(lr.Range, lo.ListColumns("LATITUDE").Range).Value
Lon = Intersect(lr.Range, lo.ListColumns("LONGITUDE").Range).Value
'Write St La Long & KML Strings for Chosen Stations
StrA = StrA & Sheets("kml").Range("B2").Value & St & Sheets("kml").Range("B4").Value & Lon & Sheets("kml").Range("B6").Value & La & Sheets("kml").Range("B8").Value
Loop
Next
Next
'Write end of KML strings to KML File
StrA = StrA & Sheets("kml").Range("B9").Value
'Open, write, close KML file
Open targetfile For Output As #1
Print #1, StrA
Close #1
'Message Box for prompting the launch of the KML file
MsgBoxTitle = ("Launch KML?")
MsgBoxPrompt = "Would you like to launch the KML File saved at " & targetfile & "?" & vbCrLf & vbCrLf & "Selecting 'No' will not prevent the file from being written."
MsgBoxResponse = MsgBox(MsgBoxPrompt, vbYesNo, MsgBoxTitle)
If MsgBoxResponse = 6 Then ThisWorkbook.FollowHyperlink targetfile
End Sub
2 回答
以下是对筛选表进行迭代的示例 . 这使用
ListObject
表比使用像表一样排列的一系列自动过滤单元更容易使用,但可以使用相同的一般想法(除非您不能调用非ListObject
表的DataBodyRange
) .创建一个表:
对它应用一些过滤器:
请注意,已隐藏了多行,并且可见行不一定是连续的,因此我们需要使用表
DataBodyRange
的.Areas
,它们是 visible .正如您已经猜测的那样,您可以使用
.SpecialCells(xlCellTypeVisible)
来执行此操作 .这是一个例子:
样本输出:
尝试并将此方法适用于您的问题,如果您在实施时遇到特定错误/问题,请告诉我们 .
只需记住更新原始问题以指出更具体的问题:)
我不得不在过滤后的数据中找到记录并更改一个值Sample data
我想将销售人员代码更改为客户C00005 .
首先我过滤并找到客户进行修改 .
enter image description here