迭代VBA上的自动过滤可见单元

我试图做一些奇怪的事情,可能不是唯一的方法,也可能是错误的。 我想迭代可见单元格(这是VBA的AutoFilter函数的结果)。

这里是我以前做过的,它的工作原理,但不是我想要的: Sheets("MySheet").Range("$A$3:$AI$10191").AutoFilter Field:=12, Criteria1:=myList, Operator:=xlFilterValues 。 myList是一个string的列表,像这样: Dim myList() as String目前,这不符合我想要的:我不希望这个空白单元格,我也希望myList()内容近似地被采取(类似于“ ”&myList&“ ”)。

为了做到这一点,我尝试了一个简单的代码行,它的工作原理如下: Sheets("MySheet").Range("$A$3:$AI$10191").AutoFilter Field:=12, Criteria1:="*"&myList(0)&"*", Operator:=xlFilterValues

我的问题是 :我想为我的列表中的所有元素做到这一点。 我一直在考虑迭代我的列表(myList),但每次我正在做一个新的迭代,它只是不会采取以前的迭代的结果在现实中,我只是想筛选“已经过滤”的行…我已经尝试了与.SpecialCells(xlCellTypeVisible)的方法,但它所有的细胞,而不仅仅是可见的…(这里是满的Sheets("MySheet").Range("$A$3:$AI$10191").SpecialCells(xlCellTypeVisible).AutoFilter Field:=12, Criteria1:="*"&myList(0)&"*", Operator:=xlFilterValues

我一直在想这样的事情:

 For i =0 to UBound(myList) Sheets("MySheet").Range("$A$3:$AI$10191").SpecialCells(xlCellTypeVisible).AutoFilter Field:=12, Criteria1:="*"&myList(i)&"*", Operator:=xlFilterValues Next i 

但是它只是在最后的.AutoFilter规则之后进行过滤。 (它过滤i=UBound(myList) ,因为每个.AutoFilter擦除前一个工作…)

如果你有任何想法…谢谢,克莱门特。

要试用高级filter,可以尝试一下。 根据需要调整它…

 Sub AdvancedFilter() Dim wsData As Worksheet, wsCriteria As Worksheet Dim myList() As String Dim i As Long, lr As Long Dim Rng As Range, Cell As Range Application.ScreenUpdating = False Set wsData = Sheets("MySheet") If wsData.FilterMode Then wsData.ShowAllData lr = wsData.UsedRange.Rows.Count On Error Resume Next Set wsCriteria = Sheets("Criteria") wsCriteria.Cells.Clear On Error GoTo 0 If wsCriteria Is Nothing Then Sheets.Add.Name = "Criteria" Set wsCriteria = ActiveSheet End If 'Assuming myList has already been populated 'Writing the column header (column 12) on Criteria Sheet in A1 wsCriteria.Cells(1, 1) = wsData.Cells(1, 12) 'Adding wild card to each element in myList For i = 1 To UBound(myList) myList(i) = "*" & myList(i) & "*" Next i 'Writing myList on Criteria Sheet wsCriteria.Range("A2").Resize(UBound(myList)).Value = Application.Transpose(myList) 'Using Advanced Filter on Data Sheet with Criteria on Criteria Sheet wsData.Range("A1").CurrentRegion.AdvancedFilter xlFilterInPlace, wsCriteria.Range("A1").CurrentRegion 'Deleting the Criteria Sheet as it is not required now Application.DisplayAlerts = False wsCriteria.Delete Application.DisplayAlerts = True 'Setting Rng as visible cells in column A On Error Resume Next Set Rng = wsData.Range("A2:A" & lr).SpecialCells(xlCellTypeVisible) If Not Rng Is Nothing Then For Each Cell In Rng 'Do your stuff here with visible range Next Cell End If If wsData.FilterMode Then wsData.ShowAllData Application.ScreenUpdating = True End Sub