vba - 在 VBA 上迭代自动过滤的可见单元格

Question

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

这是我之前所做的，它有效，但不是我想要的: Sheets("MySheet").Range("$A$3:$AI$10191").AutoFilter Field:=12, Criteria1:=myList, Operator:=xlFilterValues 。 myList 是一个字符串列表，如下所示: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 字段:=12，Criteria1:="*"&myList(0)&"*"，运算符:=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 都会删除前一个的作业...)

如果您有任何想法...谢谢，克莱门特。

Answer 1

要尝试高级过滤器，您可以尝试一下。根据需要调整它...

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