在VBA上迭代自動過濾的可見單元格

Question

我正在嘗試做一些奇怪的事情，這可能不是唯一的方法，而且可能是錯誤的。 我想迭代可見單元格（這是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都正在刪除前一個的工作...）

如果您有任何想法......謝謝，克萊門特。

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