gpt4 book ai didi

vba - Excel VBA 宏 - 循环过滤表的列

转载 作者:行者123 更新时间:2023-12-02 09:23:35 25 4
gpt4 key购买 nike

我有一个包含大量数据的电子表格(气象站目录),它计算距离用户输入的纬度和经度最近的气象站。该工作表通过计算距输入点的距离,使用 SMALL() 对这些距离进行排名,然后带有公式的 Excel 表/列表使用排名执行索引(Match())类型计算(1 是最接近的,2 是第二接近的等)来实现此目的。

工作表虽然缓慢,但工作得相当好 - 并且 Excel 表格允许根据各种标准(例如以年为单位的记录长度等)对气象站目录进行高级排序。

我正在编写一个 VBA 宏,它曾经可以工作,但当我尝试修复它时停止工作(太棒了)。

VBA 宏的目的是编写带有纬度/经度/气象站名称的 Google 地球 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

最佳答案

这是对过滤表进行迭代的示例。这使用了一个ListObject表格,它比仅仅像表格一样排列的一系列自动过滤单元格更容易使用,但是可以使用相同的一般思想(除非您无法调用非 ListObject 表的 DataBodyRange)。

创建表:

Unfiltered table

对其应用一些过滤器:

Filtered table

请注意,已经隐藏了几行,并且可见行不一定是连续的,因此我们需要使用表的 DataBodyRange.Areas,它是 可见

正如您已经猜测的那样,您可以使用 .SpecialCells(xlCellTypeVisible) 来执行此操作。

这是一个示例:

Sub TestFilteredTable()

Dim tbl As ListObject
Dim rngTable As Range
Dim rngArea As Range
Dim rngRow As Range

Set tbl = ActiveSheet.ListObjects(1)
Set rngTable = tbl.DataBodyRange.SpecialCells(xlCellTypeVisible)

' Here is the address of the table, filtered:
Debug.Print "Filtered table: " & rngTable.Address

'# Here is how you can iterate over all
' the areas in this filtered table:
For Each rngArea In rngTable.Areas
Debug.Print " Area: " & rngArea.Address

'# You will then have to iterate over the
' rows in every respective area
For Each rngRow In rngArea.Rows
Debug.Print " Row: " & rngRow.Address
Next
Next

End Sub

示例输出:

Filtered table: $A$2:$G$2,$A$4:$G$4,$A$6:$G$6,$A$9:$G$10
Area: $A$2:$G$2
Row: $A$2:$G$2
Area: $A$4:$G$4
Row: $A$4:$G$4
Area: $A$6:$G$6
Row: $A$6:$G$6
Area: $A$9:$G$10
Row: $A$9:$G$9
Row: $A$10:$G$10

尝试使此方法适应您的问题,如果您在实现该方法时遇到特定错误/问题,请告诉我。
请记住更新您的原始问题以表明更具体的问题:)

关于vba - Excel VBA 宏 - 循环过滤表的列,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/19284913/

25 4 0
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com