質問番号: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)を用いた方法も実用に耐えうる速度が出ていると思います。