質問番号:1467245868

指定した約1000のキーワードを含む行を削除したいです
今、Sheet1のA列にずらりとデータが2万行ほど並んでいます。
そしてSheet2のC列に、1000行ほどデータが並んでおります。

この状況におきまして、Sheet2のC列の1000行(1000セル)のデータの各文字列が、もしSheet1のA列の各セル(20000セル)に含まれていた場合。
該当するA列のデータを、行ごと削除していきたいのです。

そのような処理がマクロ等で可能でしたらお教えいただけないでしょうか。
よろしくお願い致します。

質問文の内容とは少し違いますが、セルの値を検索する方法を4つのアルゴリズムで比較してみました。

比較アルゴリズム

・検査値のセルと検索値のセルを単純に2重ループで比較(Test1)

・Match関数(ワークシート関数)を利用して検索(Test2)

・検査値と検索値をバリアント配列にコピーした後、2重ループで比較(Test3)

・Findメゾットを利用して検索(Test4)

条件

・全部の方法で同一のデータを利用する。(検査値、検索値共に数字・アルファベット大文字小文字をランダムに10文字抽出)
  (テストデータは「ランダム文字列ジェネレータ」http://app.nanoway.net/random/ を利用しました。)

・検索値は必ず見つかるものとする。(見つからない場合の処理は今回省略)

・検査値が見つかったら、対応する配列にTrue(論理値)をセットする。

プログラム

Option Explicit

Const Quantity As Integer = 100 ' 検索件数

Sub main()

    Dim StartTime As Date
    Dim EndTime As Date
    Dim DustTime1 As Date
    Dim DustTime2 As Date
    Dim DustTime3 As Date
    Dim DustTime4 As Date
    
    StartTime = Time
    Call Test1
    EndTime = Time
    DustTime1 = EndTime - StartTime
    
    StartTime = Time
    Call Test2
    EndTime = Time
    DustTime2 = EndTime - StartTime
    
    StartTime = Time
    Call Test3
    EndTime = Time
    DustTime3 = EndTime - StartTime
    
    StartTime = Time
    Call Test4
    EndTime = Time
    DustTime4 = EndTime - StartTime
    
    MsgBox "検索件数:" & Quantity & vbCrLf & "TEST1:" & Format(DustTime1, "hh:mm:ss") & vbCrLf & "TEST2:" & Format(DustTime2, "hh:mm:ss") & vbCrLf & "TEST3:" & _
        Format(DustTime3, "hh:mm:ss") & vbCrLf & "TEST4:" & Format(DustTime4, "hh:mm:ss")
    
End Sub


Function Test1()

    Dim WS1 As Worksheet
    Dim WS2 As Worksheet
    Dim MaxRow As Integer
    Dim MatchFlag(20000) As Boolean
    Dim lp1 As Integer
    Dim lp2 As Integer

    Set WS1 = Worksheets(1)
    Set WS2 = Worksheets(2)
    MaxRow = WS1.Range("A" & Rows.Count).End(xlUp).Row
    
    For lp1 = 1 To Quantity
        For lp2 = 1 To MaxRow
            If WS2.Cells(lp1, 1) = WS1.Cells(lp2, 1) Then
                MatchFlag(lp2) = True
                Exit For
            End If
        Next lp2
    Next lp1

End Function


Function Test2()

    Dim WS1 As Worksheet
    Dim WS2 As Worksheet
    Dim RowNo As Integer
    Dim MatchFlag(20000) As Boolean
    Dim lp1 As Integer

    Set WS1 = Worksheets(1)
    Set WS2 = Worksheets(2)
    
    For lp1 = 1 To Quantity
        RowNo = Application.WorksheetFunction.Match(WS2.Cells(lp1, 1).Value, WS1.Range("A:A"), 0)
        MatchFlag(RowNo) = True
    Next lp1

End Function


Function Test3()

    Dim WS1 As Worksheet
    Dim WS2 As Worksheet
    Dim MaxRow As Integer
    Dim Comp1 As Variant
    Dim Comp2 As Variant
    Dim MatchFlag(20000) As Boolean
    Dim lp1 As Integer
    Dim lp2 As Integer

    Set WS1 = Worksheets(1)
    Set WS2 = Worksheets(2)
    
    Comp1 = WS1.Range("A1:A20000")
    Comp2 = WS2.Range("A1:A" & Quantity)
   
    MaxRow = WS1.Range("A" & Rows.Count).End(xlUp).Row
    For lp1 = 1 To Quantity
        For lp2 = 1 To MaxRow
            If Comp2(lp1, 1) = Comp1(lp2, 1) Then
                MatchFlag(lp1) = True
                Exit For
            End If
        Next lp2
    Next lp1

End Function


Function Test4()

    Dim WS1 As Worksheet
    Dim WS2 As Worksheet
    Dim RowNo As Integer
    Dim MatchFlag(20000) As Boolean
    Dim lp1 As Integer

    Set WS1 = Worksheets(1)
    Set WS2 = Worksheets(2)

    For lp1 = 1 To Quantity
        RowNo = WS1.Cells.Find(WS2.Cells(lp1, 1)).Row
        MatchFlag(RowNo) = True
    Next lp1

End Function

結果

4種類のアルゴリズムで一番早かったのはMatch関数(Test2)を用いた方法でした。 ただ、バリアント配列(Test3)やFindメゾット(Test4)を用いた方法も実用に耐えうる速度が出ていると思います。