【VBA】複数行からの抽出について

Question

【VBA】複数行からの抽出について

Anonymous

表A"検索対象_商品名"に記載されている商品名を、表B"商品データ"に記載されている商品名から検索して、

該当行に記載されている情報を抽出したいです。

===============================================================

【表A：検索対象_商品名】

検索対象_商品名

スラックスA

ワイシャツ

ジャケット

：

【表B：商品データ】

発注番号　商品名　仕入れ先　金額　・・・

HB-0001　スラックスA　A社　1000　(★)

HB-0002　スラックスA　B社　2000　(★)

HB-0003　スラックスA　A社　1500　(★)

HB-0004　ワイシャツ　A社　500　　(★)

HB-0005　スラックスB　A社　500

HB-0006　スラックスB　A社　500

HB-0007　ジャケット　C社　10000　(★)

HB-0008　ジャケット　B社　15000　(★)

：

【表C：出力結果】

発注番号　商品名　仕入れ先　金額

(★)行が抽出されるイメージ

===============================================================

表Aは最大100行×1列程度、表Bは現状18万行×40列程度のデータ量があり、検索キーとなる商品名は、表B内では重複しています。(表A内では重複なし)

・表Bを連想配列(Dictionary)化することを検討しましたが、Dictionary生成の処理中に、商品名をKEYとしてITEMを随時追加することが出来ませんでした。

・for文での繰り返し検索については、表B内に商品名が何個あるか把握できず、100行×18万の検索になり、処理時間がかかるため避けたいと考えています。

代替案・対策等ご存じの方、ご助力頂けますと幸いです。

ロックされた質問。この質問は、Microsoft サポートコミュニティから移行されました。役に立つかどうかに投票することはできますが、コメントの追加、質問への返信やフォローはできません。

0 件のコメント

2 件の回答

Answer 1

棚田優生　さま

Dictionary は重複したキーを登録できないため

表Bのすべての商品名を商品名をキーとした

Dictionary に登録することはできません。

発想を変えればどうでしょうか？

(1) 表Aの方を Dictionary に登録する

(2) 表Bの商品名が Dictionary に存在する行だけを抽出する。

どうしても表Bのすべての商品名をDictionary に登録したい場合は

Dictionaryのキーを商品名、アイテムを同じ商品名の行番号の配列として

すでに登録済みの場合、配列に追加するようにすれば登録できます。

配列の定義が難しいかもしれませんが

ご参考になれば幸いです。

追記）2024 9/29 18:18

表B を Dictionary に格納する場合も、結局 18万回 Dictionaryに存在するかチェックすることになります。

結局、表A から作成した Dictionary を使用した方が速いと思います。

処理時間を短くするには、セルを１つずつ処理せずに2次元配列に変換して処理した方が効果的です。

VBA 高速化配列などをキーワードにして検索すると例があります。

例えば下記のようにすると18万回の検索もすぐに終わります。

追記）2024 9/30 8:20

　質問の処理に近いように書き換えました。

　長いですが、参考になれば幸いです。

' 入力 Dim shtA As Worksheet Dim arrayA As Variant Dim dicA As Dictionary Dim keyA As String Dim shtB As Worksheet Dim arrayB As Variant ' 出力 Dim shtC As Worksheet Dim rangeC As Range Dim arrayC As Variant Dim cntC As Long ' 出力行数 Dim i As Long Dim j As Long 'Dictionary用入力 Set shtA = ThisWorkbook.Worksheets("表A") ' セル範囲から値を配列に読み込む arrayA = shtA.Range("A2:A100").Value 'Dictionaryの作成 Set dicA = New Dictionary For i = LBound(arrayA) To UBound(arrayA) If arrayA(i, 1) = "" Then Exit For End If keyA = arrayA(i, 1) If Not dicA.Exists(keyA) Then dicA.Add keyA, "" End If Next i '入力 Set shtB = ThisWorkbook.Worksheets("表B") ' セル範囲から値を配列に読み込む arrayB = shtB.Range("A2:D180000").Value '出力 Set shtC = ThisWorkbook.Worksheets("表C") 'とりあえず最大行数の配列を作成 ' 後で実際の行数に縮小する Set rangeC = shtC.Range("A2:D180000") arrayC = rangeC.Value cntC = 0 For i = LBound(arrayB, 1) To UBound(arrayB, 1) keyA = arrayB(i, 2) If keyA <> "" Then If dicA.Exists(keyA) Then cntC = cntC + 1 For j = LBound(arrayB, 2) To UBound(arrayB, 2) 'arrayC(cntC, j) = "b" & arrayB(i, j) arrayC(cntC, j) = arrayB(i, j) Next j End If End If Next i ' サイズを変更したセル範囲に書き戻す rangeC.ClearContents If cntC > 0 Then rangeC.Resize(cntC).Value = arrayC End If

以上

Answer 2

VBA(マクロ)の公式サポート場所は、海外コミュニティとなっています。有識者が集まっている所の方が、適切なアドバイスを受けやすいでしょう。・Stack Overflow(VBA)[VBA プログラミングに関する質問]Stack Overflow には、説明的なタイトル、完全で簡潔な問題ステートメント、問題を再現する
　　ための十分な詳細の要求などのガイドラインがあることに注意してください。
　　機能要求または過度に広範な質問は、トピック外と見なされます。
　　新しいユーザーの場合は、Stack Overflow ヘルプセンターにアクセスして詳細を確認して下さい。※ 閲覧者・回答者が多い公式サポートサイトをお勧めします。英語で質問を送信してください。所謂、くれくれ君には対応してくれないと思います。

次の方法で共有

【VBA】複数行からの抽出について

2 件の回答