人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

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

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

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


●質問者: moon-fondu
●カテゴリ:コンピュータ 学習・教育
○ 状態 :終了
└ 回答数 : 1/1件

▽最新の回答へ

1 ● a-kuma3
●1500ポイント ベストアンサー

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

Sub delete_by_keyword_list()

 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 re.Test(txt) Then
 Cells(r, 1).EntireRow.Delete
 last_row = last_row - 1
 Else
 r = r + 1
 End If
 DoEvents
 Loop

 Set re = Nothing

End Sub

以下の前提、制約があります。

三番目が、もしかしたら要件を満たせないかもしれません。
実は、InStr 関数を使って素直に引き当てるようなマクロも書いてみたのですが、ちょっと遅すぎるので、正規表現を使うパターンにしてみました。
特別に速くはない数年前のノートPC で、キーワードが 1000件、対象のデータが 9000件、削除されるデータが 100件程度というテストデータで試したところ、以下のような結果になりまして。

また、削除される行が多いと、この回答で書いたコードでも数分のオーダで実行時間がかかることがあります。
何度も使うようなマクロで、削除する行が多い場合には、補足をお願いします。


データを削除してしまうマクロなので、バックアップは確実にお願いします。


moon-fonduさんのコメント
a-kuma3さんありがとうございます、うまくいきました(^^;) ちなみになのですが…もう1つ、質問がありまして。 新しく立ち上げましたので、a-kuma3さんの高度な技術でお力添えをいただけますと幸いです。 http://q.hatena.ne.jp/1467396550 よろしくお願い致しますm(__)m
関連質問

●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ