今、Sheet1のA列にずらりとデータが2万行ほど並んでいます。
そしてSheet2のC列に、1000行ほどデータが並んでおります。
この状況におきまして、Sheet2のC列の1000行(1000セル)のデータの各文字列が、もしSheet1のA列の各セル(20000セル)に含まれていた場合。
該当するA列のデータは残し、それに該当しないセルは、行ごと削除していきたいのです。
そのような処理がマクロ等で可能でしたらお教えいただけないでしょうか。
よろしくお願い致します。
標準モジュールに以下のコードを貼り付けて、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分近くかかります (´・ω・`)
ありがとございます、sheet1は2万行、sheet2は900ぐらいデータがありましたが、5分と少しぐらいでうまく抽出ができました!ほんとに感謝です(^^♪
2016/07/03 13:08:09