iT邦幫忙

0

Excel VBA 篩選三條件以上問題

因需求希望能在同一欄位多條件篩選。

AutoFilter Field:=1, Criteria1:=Array("AB*"), Criteria2:=Array("BC*"), Operator:=xlOr

可是使用以上VBA只能篩選兩個條件,輸入第三個條件就會錯誤。
https://ithelp.ithome.com.tw/upload/images/20201209/201311034fdv4Adp7f.jpg

先在此感謝每位回答者。

圖片
  直播研討會
圖片
{{ item.channelVendor }} {{ item.webinarstarted }} |
{{ formatDate(item.duration) }}
直播中
0
rogeryao
iT邦超人 8 級 ‧ 2020-12-10 11:02:15
最佳解答

假設第一行是標題"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

感謝你的回答,非常有幫助

rogeryao iT邦超人 8 級 ‧ 2021-05-25 23:58:30 檢舉

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

原始資料 :
https://ithelp.ithome.com.tw/upload/images/20210525/20085021Cb1MbOEW2a.png

最終資料 :
https://ithelp.ithome.com.tw/upload/images/20210525/20085021cyhgYcvabk.png

0
richardsuma
iT邦大師 1 級 ‧ 2020-12-09 23:35:24

有嘗試,但是仍無法得到想要結果,謝謝你的回答

For Each Rng In Range("A1:A10")
If Rng.Text Like "AB" & "" Or
Rng.Text Like "BC" & "
" Or
Rng.Text Like "CD" & "*" Then
Debug.Print Rng.Address & ": " & Rng.Text
End If
Next

0
paicheng0111
iT邦大師 5 級 ‧ 2020-12-09 23:38:58
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

謝謝回答,但是結果不是我要的

可惜沒能幫上忙

我要發表回答

立即登入回答