リストにある文字列を含むか判定
2021年06月13日
テーブルを作ったのはいいけど、不要なデータが紛れ込んでいた！！
正しいデータのリストがあって、不要データか判別したい。
そんなニーズを叶えるマクロを作ってみた。
いきなり作りたくなる気持ちを抑えて、まずはネットで検索。
クリーンヒット！
https://kirinote.com/excelvba-listcharacter/
もろにやりたいことを実現するページを発見。
参考サイトでは色分けをしていたけど、
右側のセルにキーワードをいくつ含むかカウントする処理を入れた。
リストの内容を配列に格納するのがポイントで、
セルを参照した処理だと行数の多いリストでは処理しきれない。
行ループについても配列にして、出力も配列に格納したほうが早いけど
手間の割に劇的な効果はないと思うのでこのまま。
対象のシート名、テーブルのタイトル行、参照列、出力列を定数化した。
以下、ソース。
正しいデータのリストがあって、不要データか判別したい。
そんなニーズを叶えるマクロを作ってみた。
いきなり作りたくなる気持ちを抑えて、まずはネットで検索。
クリーンヒット！
https://kirinote.com/excelvba-listcharacter/
もろにやりたいことを実現するページを発見。
参考サイトでは色分けをしていたけど、
右側のセルにキーワードをいくつ含むかカウントする処理を入れた。
リストの内容を配列に格納するのがポイントで、
セルを参照した処理だと行数の多いリストでは処理しきれない。
行ループについても配列にして、出力も配列に格納したほうが早いけど
手間の割に劇的な効果はないと思うのでこのまま。
対象のシート名、テーブルのタイトル行、参照列、出力列を定数化した。
以下、ソース。
Sub リストの文字があるかどうか探す()
'https://kirinote.com/excelvba-listcharacter/
Const KeySHname = "keyData"
Const TableSHname = "tableData"
Const TitleRow = 1
Const KeyCol = 3 '検索対象列
Const ColOut = 4 '出力列
Dim LastRow As Long
Dim Key1List() As String
Dim Key2List() As String
Dim Gyo As Long, i As Long, j As Long
'GCTデータを配列に格納
With Worksheets(KeySHname)
LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
ReDim Preserve Key1List(LastRow - 2) '配列の要素数を指定
ReDim Preserve Key2List(LastRow - 2) '配列の要素数を指定
'リストの文字列を配列に格納
For Gyo = 2 To LastRow
i = Gyo - 2
Key1List(i) = .Cells(Gyo, 1)
Key2List(i) = .Cells(Gyo, 2)
Next Gyo
End With
'格納前に初期化
Worksheets(TableSHname).Select
Range(Cells(TitleRow, ColOut), Cells(Rows.Count, ColOut + 1)).ClearContents
Cells(TitleRow, ColOut) = "Hit1"
Cells(TitleRow, ColOut + 1) = "Hit2"
LastRow = Cells(Rows.Count, KeyCol).End(xlUp).Row '最終行を更新
For Gyo = TitleRow + 1 To LastRow
Application.StatusBar = "データ処理中（" & Gyo - 1 & "/" & LastRow - 1 & "）"
For j = 1 To UBound(Key1List)
'リストの文字列が含まれている場合、
If InStr(Cells(Gyo, KeyCol), Key1List(j)) > 0 Then Cells(Gyo, ColOut) = Cells(Gyo, ColOut) + 1
If InStr(Cells(Gyo, KeyCol), Key2List(j)) > 0 Then Cells(Gyo, ColOut + 1) = Cells(Gyo, ColOut + 1) + 1
Next j
Next Gyo
Application.StatusBar = ""
End Sub
PR
Comment