Q&A
列C（出力結果）の２行目は「たまごっち２」となるのではないですか？
前提・実現したいこと
VBAで大量データの一部一致検索を行いたいです。
処理件数が多く、どのように処理すればいいか分からず、悩んでいます。
１：列Aのキーワードを元に列B内を検索。
２：”部分一致”すれば、列Cに部分一致したデータ(列Bの値）を全てカンマ区切りで出力します。
３：それ以外は NA を列Cへ出力します。
【データサンプル↓】プログラム実行前
列A（100万行rawdata） ｜ 列B（20万行rawdata） ｜ 列C（空白）
アイス たまごっち２
たまごっち アイス
ほげほげランド お茶
ほげほげマウス ほげほげランドスーパー
綾鷹 ほげほげランドエクストラ
・・・ ・・・
・・ ・・
【データサンプル↓】プログラム実行後
列A（100万行rawdata） ｜ 列B（20万行rawdata） ｜ 列C（出力結果）
アイス たまごっち２ アイス
たまごっち アイス たまごっち２
ほげほげランド お茶 ほげほげランドスーパー,ほげほげランドエクストラ
ほげほげマウス ほげほげランドスーパー NA
綾鷹 ほげほげランドエクストラ NA
・・・ ・・・ ・・・
・・ ・・ ・・
・ ・ ・
発生している問題・エラーメッセージ
データが膨大な為、単純にループすると処理が終わりません（１０４８５７６行×２０万行）。 Dictionaryを使う方法では完全一致検索しかできませんでした。
試したこと
https://officedic.com/excel-vba-highspeed-find/
こちらのサイトのDictionaryを使用した方法で、”完全一致”は出来ました。
（VBA running time は大体15秒くらいでした）
補足情報（FW/ツールのバージョンなど）
Excel2019
回答3件
0
B列の単語を全部1つの文字列変数に入れて検索するというのはどうでしょうか?
VBAの制限は20億文字らしいので、20万件なら納まるかと思います。
単語長によってかなり変わるとは思いますが、とりあえずB列=20万件、A列=1万件で
やってみて約100秒でした。
VBA
1Private Sub test() 2 ' 3 ' B列を文字列変数にコピー 4 ' ※単語間の区切り記号はVbLf 5 ' ※TextJoinが使えるならそれでもよい 6 ' 7 Me.Range("B1:B200000").Copy 8 Dim CB As New DataObject 9 CB.GetFromClipboard 10 If (Not CB.GetFormat(1)) Then Exit Sub 11 12 Dim cmp As String: cmp = vbLf & CB.GetText & vbLf 13 Set CB = Nothing 14 Application.CutCopyMode = False 15 ' 16 ' 検索 17 ' 18 Dim wx As Long 19 For wx = 1 To 10000 20 Dim key As String: key = Me.Cells(wx, "A").Value 21 Dim txt As String: txt = "" 22 Dim ix As Long: ix = InStr(cmp, key) 23 If (ix > 0) Then 24 Do 25 ' 26 ' 検出した位置の直前のLF～直後LFの間が求める単語 27 ' 28 Dim sx As Long: sx = InStrRev(cmp, vbLf, ix) + 1 29 txt = txt & "," & Mid$(cmp, sx, InStr(ix, cmp, vbLf) - sx) 30 ix = InStr(ix + 1, cmp, key) 31 Loop While ix > 0 32 txt = Mid$(txt, 2) ' 先頭コンマを除く 33 Else 34 txt = "NA" 35 End If 36 37 Me.Cells(wx, "C") = txt 38 39 If ((wx Mod 1000) = 0) Then Application.StatusBar = wx 40 Next wx 41 42End Sub 43コード
投稿2021/10/25 08:51
総合スコア505
0
ベストアンサー
試しにこんな感じで書いてみましたが、やはり大量データだと厳しいですね。
VBA
1Sub Sample() 2 3 Dim ws As Worksheet 4 Dim lastA As Long, lastB As Long 5 Dim arrA As Variant, arrB As Variant 6 Dim i As Long 7 8 Set ws = ThisWorkbook.Worksheets(1) 9 lastA = ws.Range("A" & ws.Rows.Count).End(xlUp).Row 10 lastB = ws.Range("B" & ws.Rows.Count).End(xlUp).Row 11 12 arrA = ws.Columns(1).Resize(lastA).Value 13 arrB = ws.Columns(2).Resize(lastB).Value 14 15 With New Scripting.Dictionary 16 For i = 1 To lastB 17 .Item(arrB(i, 1)) = 0 18 Next 19 arrB = .Keys 20 End With 21 22 For i = 1 To lastA 23 arrA(i, 1) = Join(Filter(arrB, arrA(i, 1)), ",") 24 If arrA(i, 1) = "" Then arrA(i, 1) = "NA" 25 Next 26 27 For i = 1 To lastA 28 ws.Range("C" & i).Value = arrA(i, 1) 29 Next 30 31End Sub 32
投稿2021/10/23 02:14
総合スコア4592
私もFilter関数を使ったコードも書いてみたのですが、単純なループより遅かったです。
部分一致で高速化は難しいですね。
もともとFilter関数って結構遅いイメージがあります。
ただ、B列の行数が大量になると こちらの方が速くなる場合もあるみたいです。
（データの中身にもよるのかもしれませんが。）
アルゴリズムから考えるか、
データベースを使用してみようと思います。
ご回答ありがとうございます！
データベースを利用しても部分一致では難しいでしょうね。
データベースはインデックスを利用して検索等を高速処理してますが、部分一致では利用できませんので。
グーグルなどのWEB検索では、事前にサイトからキーワードを取り出してインデックスにするなどのテクニックを使っています。
「全文検索エンジン」でWEB検索してみるといいかもしれません。
DBでも難しいですか。
「全文検索エンジン」検索してみます、
ありがとうございます。
DBによっては全文検索機能を持っているものをあるようです。
例えばMySQLとか。
0
A列とB列をそれぞれ配列に入れて、2重ループで部分一致を検索する。
結果も配列に出力して、最後に結果配列をシートに出力ということになると思います。
エクセルで遅くなる原因はセルへの参照、更新ですので、それをなるべく少なくするという方針でいくのがいいでしょう。
vba
1Public Sub Sample() 2 Dim A(), B(), C() As String 3 Dim ACnt As Long, BCnt As Long 4 ACnt = Cells(Rows.Count, 1).End(xlUp).Row 5 A = Cells(1, 1).Resize(ACnt).Value 6 BCnt = Cells(Rows.Count, 2).End(xlUp).Row 7 B = Cells(1, 2).Resize(BCnt).Value 8 ReDim C(1 To ACnt, 1 To 1) 9 10 Dim i As Long, j As Long 11 For i = 1 To ACnt 12 For j = 1 To BCnt 13 If InStr(1, B(j, 1), A(i, 1), vbBinaryCompare) > 0 Then 14 C(i, 1) = C(i, 1) & "," & B(j, 1) 15 End If 16 Next 17 Next 18 For i = 1 To ACnt 19 If C(i, 1) = "" Then 20 C(i, 1) = "NA" 21 Else 22 C(i, 1) = Mid(C(i, 1), 2) 23 End If 24 Next 25 26 Cells(1, 3).Resize(ACnt).Value = C 27End Sub
100万×20万のサンプルデータを作成して上記のコードを実行してみたら、数十分たっても終わらないです。
これだけのループになるとさすがに配列でも苦しいですね。
1万×1万のデータで9秒ぐらいでした。
投稿2021/10/22 11:12
編集2021/10/22 12:53総合スコア34075
あなたの回答
tips
プレビュー
