如何在Excel中使用VBA循环访问Autofilter?

这里是我在Excel中使用的两张表的一个例子:

表A(Columns AP):

Loc_ID Loc_Name First Last ... ... ... 123456 ABXC - Sales John Smith 123456 ABXC - Sales Joe Smith 123456 ABXC - Sales Larry Smith 123456 ABXC - Sales Carolyn Smith 654321 ABXC - Sales Laura Smith 654321 ABXC - Sales Amy Smtih 

表B(列AZ – 每个首字母缩略词至less有一个Loc_ID,最多可以有25个):

 ABC CBA AAU ... ... ... ... 123456 423656 123578 654321 656324 875321 123987 108932 ... 

在下面的代码中,我首先查看表B中的首字母缩略词,为每个首字母缩写词创build一个新表(将其重命名为缩写),并添加来自表A的位置数据。

r=1以下,我logging了一个macros来做我想要完成的一个缩写词,它的位置,但是对于其他缩略词和它的位置,我不知道我能做些什么来循环“表B”以完成与我在下面为缩写“ABC”所做的相同的任务。

任何人都可以解决这个问题?

 Sub Macro5() Dim shtA As Worksheet 'variable represents Leavers' Dim shtB As Worksheet 'variable represents Tables' Dim shtNew As Worksheet 'variable to hold the "new" sheet for each acronym' Dim acronyms As Range 'range to define the list of acronyms' Dim cl As Range 'cell iterator for each acronmym' Dim r As Integer 'iterator, counts the number of locations in each acronym' Dim valueToFind As String 'holds the location that we're trying to Find' Dim foundRange As Range 'the result of the .Find() method' Dim MyRange As Range 'Assign our worksheets variables' Set shtA = Worksheets("Leavers") Set shtB = Worksheets("Tables") 'Assign the list of acronmys in "Tables"' Set acronyms = shtB.Range("B1:Z1") 'Loop over each DIV code:' For Each cl In acronyms.Cells 'Add new sheet for each acronym:' Set shtNew = Sheets.Add(After:=Sheets(Sheets.Count)) shtNew.Name = cl.Value 'Start each acronym at "1"' r = 1 Sheets("Tables").Select Range("B2").Select Selection.Copy Sheets("Leavers").Select ActiveSheet.Range("$A$1:$P$6463").AutoFilter Field:=1, Criteria1:="687987" Range("A1").Select Range(Selection, Selection.End(xlDown)).Select Range(Selection, Selection.End(xlToRight)).Select Selection.Copy Sheets("ABX").Select ActiveSheet.Paste Sheets("Tables").Select Range("B3").Select Selection.Copy Sheets("Leavers").Select ActiveSheet.Range("$A$1:$P$6463").AutoFilter Field:=1, Criteria1:="004740" ActiveCell.Offset(1, 0).Select With ActiveSheet.UsedRange Set MyRange = Range(.Cells(2, 1), .Cells(1, 1).Offset(.Rows.Count - 1, .Columns.Count - 1)) MyRange.Select End With Selection.Copy Sheets("ABX").Select Range("A2").Select Selection.End(xlDown).Select ActiveCell.Offset(1, 0).Select ActiveSheet.Paste Next End Sub 

尝试这个:

 Sub ject() Dim acronym As Range, cl As Range, idr As Range Dim LocIDFilter, nws As Worksheet Dim ws1 As Worksheet: Set ws1 = Sheet1 '~~> change to suit Dim ws2 As Worksheet: Set ws2 = Sheet2 '~~> change to suit Dim datarange As Range With ws1 Set datarange = .Range("A1", .Range("P" & .Rows.Count).End(xlUp)) End With Set acronym = ws2.Range("B1:Z1") For Each cl In acronym Set idr = cl.Resize(cl.Range("A" & ws2.Rows.Count).End(xlUp).Row) LocIDFilter = GetFilters(idr) Set nws = ThisWorkbook.Sheets.Add(after:= _ ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)) nws.Name = cl.Value datarange.AutoFilter 1, LocIDFilter, xlFilterValues datarange.SpecialCells(xlCellTypeVisible).Copy nws.Range("A1") Next ws1.AutoFilterMode = False End Sub 

 Private Function GetFilters(source As Range) Dim c As Range If Not source Is Nothing Then With CreateObject("Scripting.Dictionary") For Each c In source.SpecialCells(xlCellTypeVisible).Cells If Not .Exists(CStr(c.Value)) Then .Add CStr(c.Value), CStr(c.Value) Next GetFilters = .Keys End With End If End Function 

这是尝试和testing。 它将为每个首字母缩略词创build一个表格,并为每个缩写词添加相关的Loc_ID。
自定义函数用于获取每个首字母缩写词的filter,然后一次复制它。
如果您有任何疑问,请发表评论。 HTH。

循环使用.specialcells(xlcelltypevisible)这只会看过滤的结果

尝试使用此代替logging

 'Start each acronym at "1"' r = 1 With Sheets("Leavers") .Range("$A$1:$P$6463").AutoFilter Field:=1, Criteria1:="687987" .Range("A1", Cells("A1").End(xlToRight)).SpecialCells(xlCellTypeVisible).Copy End With Sheets("ABX").Paste Sheets("Leavers").Range("$A$1:$P$6463").AutoFilter Field:=1, Criteria1:="004740" With Sheets("Leaver").UsedRange Set MyRange = Range(.Cells(2, 1), .Cells(1, 1).Offset(.Rows.Count - 1, .Columns.Count - 1)) MyRange.Copy End With Sheets("ABX").Range("A2", Cells("A2").End(xlDown)).Paste 

把它放在一个for循环中,需要它运行的次数,然后改变每个常量,每个常量在循环中可以设置一个variables。