如果找不到多個搜索字串，則洗掉行

我有一列列出國家/地區的列。我希望洗掉所有沒有列出任何國家/地區的行arrchoices。（即我想保留這些國家的所有行）。我的資料大約有 4,000 行。我的宏最終改為洗掉所有行。

Sub delete_countries(sh As Worksheet, col As String)
Dim a As Variant, aWords As Variant
Dim i As Long, j As Long
Dim BanWords As String
Dim lastrow As Long
Dim arrChoices() As String

Application.StatusBar = "Deleting Countries..."
    
'Exceptions List
arrChoices = Split("Bahamas,Greece,South Africa,Kuwait,Germany,Brazil,Spain,Taiwan,Switzerland,USA,United Kingdom,Australia,Austria,British Virgin Islands,Vatican City,Cayman Islands,Bermuda,Canada,Turks and Caicos Islands,India,Israel,Ireland,Iran,Japan,Mexico,Trinidad and Tobago,US Virgin Islands,Italy,France, Portugal,United Arab Emirates,Belarus,Netherlands,Norway,Brunei,Kenya,Sweden,China,Hong Kong,Seychelles,Saudi Arabia,Turkey,Anguilla,Thailand,Maldives, ", ", ")

''Find Last Row
sh.Activate
With sh
    lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

'Reverse Iteration
For i = lastrow To 2 Step -1
    For j = LBound(arrChoices) To UBound(arrChoices)
        If InStr(1, Range(col & i), arrChoices(j)) = 0 Then Rows(i).EntireRow.Delete
    Next j
Next i

End Sub

如前所述，我正在嘗試為自動過濾器設定陣列，但在應用過濾器時出現錯誤：

Set imp_obj = x_seasonal.ListObjects(1)
imp_obj.AutoFilter.ShowAllData
arrChoices = Split("Bahamas,Greece,South Africa,Kuwait,Germany,Brazil,Spain,Taiwan,Switzerland,USA,United Kingdom,Australia,Austria,British Virgin Islands,Vatican City,Cayman Islands,Bermuda,Canada,Turks and Caicos Islands,India,Israel,Ireland,Iran,Japan,Mexico,Trinidad and Tobago,US Virgin Islands,Italy,France, Portugal,United Arab Emirates,Belarus,Netherlands,Norway,Brunei,Kenya,Sweden,China,Hong Kong,Seychelles,Saudi Arabia,Turkey,Anguilla,Thailand,Maldives, ", ", ")

'Filter Values
With imp_obj.Range
    .AutoFilter Field:=2, Criteria1:=arrChoices
End With

uj5u.com熱心網友回復：

過濾資料 ( Application.Match, AutoFilter)

Option Explicit


Sub DeleteCountriesTEST()
    DeleteCountries ThisWorkbook.Worksheets("Sheet1"), "A"
End Sub


Sub DeleteCountries(ByVal ws As Worksheet, ByVal Col As Variant)
    
    ' The Constants
    Const KeeperList As String = "Bahamas,Greece,South Africa,Kuwait," _
        & "Germany,Brazil,Spain,Taiwan,Switzerland,USA,United Kingdom," _
        & "Australia,Austria,British Virgin Islands,Vatican City," _
        & "Cayman Islands,Bermuda,Canada,Turks and Caicos Islands,India," _
        & "Israel,Ireland,Iran,Japan,Mexico,Trinidad and Tobago," _
        & "US Virgin Islands,Italy,France,Portugal,United Arab Emirates," _
        & "Belarus,Netherlands,Norway,Brunei,Kenya,Sweden,China,Hong Kong," _
        & "Seychelles,Saudi Arabia,Turkey,Anguilla,Thailand,Maldives"
    Const DelCriteria As String = "#N/A"
    
    Application.ScreenUpdating = False
    
    ' The Two Ranges
    If ws.FilterMode Then ws.ShowAllData
    Dim srg As Range: Set srg = ws.Range("A1").CurrentRegion.Columns(Col)
    Dim sdrg As Range: Set sdrg = srg.Resize(srg.Rows.Count - 1).Offset(1)
    
    ' The Three Arrays
    Dim Keepers() As String: Keepers = Split(KeeperList, ",")
    Dim sData As Variant: sData = sdrg.Value
    Dim dData As Variant: dData = Application.Match(sData, Keepers, 0)
    
    ' The Criteria
    Dim r As Long
    For r = 1 To UBound(sData, 1)
        If IsError(dData(r, 1)) Then
            If dData(r, 1) = CVErr(xlErrNA) Then sData(r, 1) = dData(r, 1)
        End If
    Next r
    
    ' The Filter
    sdrg.Value = sData
    srg.AutoFilter 1, DelCriteria
    
    ' The Third Range
    Dim svdrg As Range
    On Error Resume Next
        Set svdrg = sdrg.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    ws.AutoFilterMode = False
    
    ' The Deletion
    Dim IsSuccess As Boolean
    If Not svdrg Is Nothing Then svdrg.EntireRow.Delete: IsSuccess = True
    
    Application.ScreenUpdating = True
    
    ' The Information
    If IsSuccess Then
        MsgBox "Countries deleted.", vbInformation
    Else
        MsgBox "Countries had already been deleted.", vbExclamation
    End If

End Sub

標籤：擅长 vba

上一篇：Excel洗掉多個可能字串的字串后的文本

下一篇：如何在python中的檔案夾中生成自動增量？