因需求希望能在同一欄位多條件篩選。
AutoFilter Field:=1, Criteria1:=Array("AB*"), Criteria2:=Array("BC*"), Operator:=xlOr
可是使用以上VBA只能篩選兩個條件,輸入第三個條件就會錯誤。
先在此感謝每位回答者。
假設第一行是標題"ITEM"而不是"AB001"
Private Sub CommandButton1_Click()
    Dim dicCriteria As Object
    Dim vData As Variant
    Dim i As Long
    
    Set dicCriteria = CreateObject("Scripting.Dictionary")
    dicCriteria.CompareMode = 1 'vbTextCompare
    With ActiveSheet
        If .FilterMode Then .AutoFilterMode = False
        With .Range("A1").CurrentRegion
            vData = .Columns(1).Cells.Value
            For i = 2 To UBound(vData, 1) '排除標題並從第二行數據開始
                If Not dicCriteria.Exists(vData(i, 1)) Then
                    Select Case True
                        Case vData(i, 1) Like "AB*"
                            dicCriteria(vData(i, 1)) = ""
                        Case vData(i, 1) Like "BC*"
                            dicCriteria(vData(i, 1)) = ""
                        Case vData(i, 1) Like "CD*"
                            dicCriteria(vData(i, 1)) = ""
                        Case vData(i, 1) Like "DE*"
                            dicCriteria(vData(i, 1)) = ""    
                    End Select
                End If
            Next i
            If dicCriteria.Count > 0 Then
                .AutoFilter field:=1, Criteria1:=dicCriteria.Keys, Operator:=xlFilterValues
            Else
                MsgBox "No records found.", vbInformation
            End If
        End With
    End With
    Set dicCriteria = Nothing
End Sub
參考來源: Using VBA to create wildcard filter for multiple criteria
感謝你的回答,非常有幫助
To msmplayv121068,
動態篩選如下 :
Private Sub CommandButton1_Click()
    Dim dicCriteria As Object
    Dim vData As Variant
    Dim i As Long
    
    Set dicCriteria = CreateObject("Scripting.Dictionary")
    dicCriteria.CompareMode = 1 'vbTextCompare
    
    Dim ConditionStart, ConditionEnd As Integer
    ConditionStart = 2
    ConditionEnd = Range("B65536").End(xlUp).Row
    
    With ActiveSheet
        If .FilterMode Then .AutoFilterMode = False
        With .Range("A1").CurrentRegion
            vData = .Columns(1).Cells.Value
            For i = 2 To UBound(vData, 1) '排除標題並從第二行數據開始
                If Not dicCriteria.Exists(vData(i, 1)) Then
                    For K = ConditionStart To ConditionEnd
                        If Range("B" & K).Value <> "" Then
                            Select Case True
                                Case vData(i, 1) Like Range("B" & K).Value
                                dicCriteria(vData(i, 1)) = ""
                            End Select
                        End If
                    Next K
                End If
            Next i
            If dicCriteria.Count > 0 Then
                .AutoFilter field:=1, Criteria1:=dicCriteria.Keys, Operator:=xlFilterValues
            Else
                MsgBox "No records found.", vbInformation
            End If
        End With
    End With
    Set dicCriteria = Nothing
End Sub
原始資料 :
最終資料 :
sub test()
    dim myRng as Range, cell as range
    dim out as string, ary as variant
    
    set myRng = Range("A1:A10")
    for each cell in myRng
        select case true
            case cell like "AB*": out = out & "|" & cell
            case cell like "BC*": out = out & "|" & cell
            case cell like "CD*": out = out & "|" & cell
            case cell like "DE*": out = out & "|" & cell
            case else
        end select
    next cell
    
    out = mid(out,2)
    ary = split(out,"|")
    myRng = application.transpose(ary)
End sub