指定した約1000のキーワードを含む行以外を削除したいです


今、Sheet1のA列にずらりとデータが2万行ほど並んでいます。
そしてSheet2のC列に、1000行ほどデータが並んでおります。

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

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

回答の条件
  • 1人10回まで
  • 13歳以上
  • 登録:2016/07/02 03:09:10
  • 終了:2016/07/03 13:08:23

ベストアンサー

id:a-kuma3 No.1

a-kuma3回答回数4325ベストアンサー獲得回数17732016/07/02 09:02:19

ポイント1500pt

標準モジュールに以下のコードを貼り付けて、Sheet1 を表示している状態で delete_by_keyword_list2 サブルーチンを実行してください。

Sub delete_by_keyword_list2()
    On Error GoTo ErrorHandler

    Application.ScreenUpdating = False

    Dim keyword(), work()

    Set ref_s = Sheets("Sheet2")

    ' C列の最終行を調べる
    last_row = ref_s.Cells(Rows.Count, 3).End(xlUp).Row

    ReDim work(last_row)
    i = 1
    For r = 1 To last_row
        Set cell = ref_s.Cells(r, 3)
        If Not IsEmpty(cell) And cell.Value <> "" Then
            work(i) = cell.Value
            i = i + 1
        End If
    Next

    n = i - 1
    ReDim keyword(1 To n)
    For i = 1 To n
        keyword(i) = work(i)
    Next

    Set re = CreateObject("VBScript.RegExp")
    re.Pattern = Join(keyword, "|")

    ' A列の最終行を調べる
    last_row = Cells(Rows.Count, 1).End(xlUp).Row

    r = 2
    Do While r <= last_row
        deleted = False
        txt = Cells(r, 1).Value
        If Not re.Test(txt) Then        ' ★基本的には、ここを変えただけ
            Cells(r, 1).EntireRow.Delete
            last_row = last_row - 1
        Else
            r = r + 1
        End If
        DoEvents
    Loop

FINAL:
    Set re = Nothing
    Application.ScreenUpdating = True

    Exit Sub

ErrorHandler:
    MsgBox "エラー!"
    GoTo FINAL

End Sub

前回の質問のコードでうまく行ったということなので、正規表現を使ったパターンでやってます。
if 文の条件を反転させただけなのですが、条件が判定すると削除する行の数も反転します。
前回のケースで多いのか、今回の方が多いのかが分からないので、画面表示の更新を止めて、少し早く動作するようにしてみました。

特別に速くはない数年前のノートPC で、キーワードが 1000件、対象のデータが 9000件、削除されるデータが 8900件程度というテストデータで試したところ、40秒くらいで削除が完了しました。
画面更新を活かしたままだと、3分近くかかります (´・ω・`)

id:moon-fondu

ありがとございます、sheet1は2万行、sheet2は900ぐらいデータがありましたが、5分と少しぐらいでうまく抽出ができました!ほんとに感謝です(^^♪

2016/07/03 13:08:09

コメントはまだありません

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません