よろしくお願いいたします。
エクセルのAシートに、
名の読みガナ|年齢
という、2列×3000行の表があります。
Bシートには、マスターデータとして
メンバーID|名前|名の読みガナ|年齢|...
という表が、5000行ほどあります。
以下の作業を、VBAで自動化して処理したいです。
↓↓↓
最終的に、Bシートの表に対し名前と年齢で照合し、Aシートの3列目に、メンバーIDをできるかぎり当てはめる。できる限りというのは、Bシートのマスターには、同姓同名同年齢の人がいないとは限らず、また、Bシートには誤入力の可能性もあるので、照合できない行についてはそのまま空白として残す。
↑↑↑
これを実現するためには、
<方法1>
1)Bシートの左端に列を追加し、「読みガナ&年齢」という値を作成する(Bを1回ループ)
2)Bシートを「読みガナ&年齢」の列基準の昇順で並びかえる
3)Aシートの3列目に、「=VLOOKUP($A1&$B1,B!A1:B5000,2,FALSE)という関数を書き込む
というのを考えました。
しかしこれでは、同姓同名同年齢がちゃんと不可となるか心配です。
<方法2>
1)Bシートを、読みガナの昇順で並べ替え
2)A表をループさせて1行ずつ、B表の先頭行から最終行まで、合うものがないか調べる
3)読みガナと年齢が合致し、また次の行が合致しなかったら、メンバーIDをコピペし、次のループへ
4)最後まで合致がみつからなかったら、次のループへ
というのも考えました。
しかし、これでは、ループによって最大3000×5000回の照合を試みることになり、いくらなんでも重くなるんじゃないかと心配です。
このように、ただのVLOOKUPではなく、
・該当データがなかったり該当データが複数ある場合は何もしない
・とにかく大量のデータ
という場合は、何かいい方法ってないでしょうか?
気になる質問をクリップする
クリップした質問は、後からいつでもMYページで確認できます。
またクリップした質問に回答があった際、通知やメールを受け取ることができます。
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
回答5件
0
ベストアンサー
ご使用のExcelがWindows版ならば「Dictionary」オブジェクトを使用すると高速かつ簡単に実現できます。
(補足)
Mac版の場合は、クラスモジュールを使って「Dictionary」を自前で作成すれば対応できるようです。
【実装例】
標準モジュールに以下のように記載します。
VBA
1Sub CheckID() 2 Dim dicYomiAge As Object, strKey As String 3 Dim lngEndRow As Long, I As Long 4 Dim rngData As Range 5 Dim vntData As Variant 6 7 Set dicYomiAge = CreateObject("Scripting.Dictionary") 8 9 '-- マスターデータを辞書に取り込み 10 With ThisWorkbook 11 With .Worksheets("B") 12 '-- 最終行を検出 13 lngEndRow = .Cells(Rows.Count, 1).End(xlUp).Row 14 15 '-- マスターデータを配列へ取り込み 16 Set rngData = .Range(.Cells(2, 1), .Cells(lngEndRow, 4)) 17 vntData = rngData.Value2 18 Set rngData = Nothing 19 20 '-- 「読みガナ&年齢」をキーに「メンバーID」を辞書に登録する 21 '-- 「読みガナ&年齢」が重複していたら「NG」にする 22 For I = 1 To lngEndRow - 1 23 strKey = vntData(I, 3) & "_" & vntData(I, 4) 24 If dicYomiAge.exists(strKey) Then 25 dicYomiAge(strKey) = "NG" 26 Else 27 dicYomiAge.Add strKey, vntData(I, 1) 28 End If 29 Next I 30 End With 31 End With 32 33 '-- シートAにメンバーIDをマッピングする 34 With ThisWorkbook 35 With .Worksheets("A") 36 '-- 最終行を検出 37 lngEndRow = .Cells(Rows.Count, 1).End(xlUp).Row 38 39 '-- チェック対象データを配列へ取り込み 40 Set rngData = .Range(.Cells(2, 1), .Cells(lngEndRow, 3)) 41 vntData = rngData.Value2 42 43 '-- 「読みガナ&年齢」をキーに「メンバーID」を辞書に登録する 44 '-- 「読みガナ&年齢」が重複していたら「NG」にする 45 For I = 1 To lngEndRow - 1 46 strKey = vntData(I, 1) & "_" & vntData(I, 2) 47 If dicYomiAge.exists(strKey) Then 48 '-- 該当データがあれば登録済みのID(ただし重複ありならNG) 49 vntData(I, 3) = dicYomiAge(strKey) 50 Else 51 '-- 該当がなければNG 52 vntData(I, 3) = "NG" 53 End If 54 Next I 55 56 '-- 照合済みのメンバーIDを書き戻し 57 rngData.Value = vntData 58 Set rngData = Nothing 59 End With 60 End With 61 62 Set dicYomiAge = Nothing 63End Sub
この方式のメリットは、「Dictionary」(=連想配列)を使うことで、検索対象のデータをソートする必要がなく、そもそも検索自体も不要(Keyが登録されていれば値を参照するだけ)であること、また、Dictionaryに登録する時点で重複するKeyも検出でき重複分をどう扱うか(NGにするかどうか)も決められる、ということです。
さらに処理に際して、マスターデータm行、照合対象データn行の場合、m+n回ループを回すだけで良いので、データ数が多くてもかなり高速に処理できます。
以上、ご参考になれば幸いです。
投稿2018/04/04 15:03
総合スコア5936
0
あらかじめBシートをソートしておくのであれば、VLOOKUPやMATCH関数で近似一致モードを使用すると高速で検索を行うことが出来ます。
ただし、この場合あくまで近似検索となるため
「検索に使ったものと、見つかった位置にあるものが同じかどうか」
を判定する必要があります。
今回の場合、さらに
- 該当データがなかったり該当データが複数ある場合は何もしない
の条件があるため、
「見つかった位置の前後に同じ値が無いか」
をチェックし、同じ値があれば空白にすればよいでしょう
(昇順の場合は前の値をチェックすれば良さそうですが、実際に試して確認してみてください)。
ワークシート関数のみで実装するならMATCH関数のみの列と、上記チェックを行う列の2列を用意する。
VBAで行う場合は、MATCH関数で近似一致検索して、見つかった位置を元に上記チェックを行えば良いかと思います。
VLOOKUPやMATCH関数の近似一致モードなどの詳細は以下のリンク先を確認してください。
VLOOKUPの高速化方法と速度比較(VLOOKUP/INDEX+MATCH) | 蒼月書庫
【奥義】大量データでの高速VLOOKUP|エクセル関数超技
投稿2018/04/04 14:22
総合スコア2166
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2018/04/06 14:37
0
シートBをひとつの文字列に入れてInstrで検索するのはどうでしょうか? 性能的な検証はしていないので、アイデアだけですが。
※ミソは、indexTextを作るとき重複チェックを行ない、重複があったらindexTextの前方に登録することです。Instrの検索は前から行なわれますので、これにより反映時に重複が検出できます。
VBA
1 Dim indexText As String: indexText = "" 2 Dim ix As Long 3 Dim rx As Long 4 Dim key As String 5 ' 6 ' シートBのインデックスの作成 7 ' 8 For rx = 1 To 5000 9 key = "," & SheetB.Cells(rx, "C") & "(" & SheetB.Cells(rx, "D") & ")" ' key= ",読みガナ(年齢)" 10 If (InStr(indexText, key) > 0) Then 11 indexText = "0000" & key & indexText ' 重複。行番号を0000(=重複の意)として文字列の先頭に追加 12 Else 13 indexText = indexText & Format(rx, "0000") & key ' 重複なし。文字列の後端(先頭でもよいが)に追加。行番号は固定長 14 End If 15 Next rx 16 ' 17 ' シートAの各行に反映 18 ' 19 For rx = 1 To 3000 20 key = "," & SheetA.Cells(rx, "A") & "(" & SheetA.Cells(rx, "B") & ")" 21 ix = InStr(indexText, key) 22 If (ix > 0) Then 23 Dim rowTxt As String: rowTxt = Mid$(indexText, ix - 4, 4) 24 If (rowTxt <> "0000") Then SheetA.Cells(rx, "C") = SheetB.Cells(Val(rowTxt), "A") 25 End If 26 Next rx 27
なお、VBAの文字列操作は扱う文字列列長が大きくなると性能が急激に悪化するポイントがあるように思います。上記のコードで3000×5000のテーブルを試したところ、当方のPC(Windws 7,Excel 2010)では5秒程度で完了しましたが、これ以上大きいテーブルを扱う場合はご注意ください。
投稿2018/04/06 01:12
総合スコア505
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
0
年齢のデータがあるので、それをうまく活用すれば、すばやい処理ができそうです。
まずAシート、Bシートともに、年齢順に並べ替えておきます。
Bシートを上から順に処理します。
1行目の年齢と同じ年齢をAシートの上から順に探します。
見つかった行を保持しておきます。
次に読みガナをAシートから探します。
この時年齢の値が変わったら検索は終了です。
Bシートの2行目に移ります。
保持している年齢が1行目と同じであれば、Aシートの検索開始行を保持していた行からにします。
年齢が異なっている場合はまた年齢の検索から始めます。
というような処理にすれば3000x5000のフルループにはならず、それほど時間もかからないと思います。
ちなみに3000x5000をフルで行った場合、私の環境では1分程度で完了しました。
単純なセル参照のみですが。
まずは時間を気にせず、単純に作ってみるのもひとつの手です。
投稿2018/04/05 00:40
総合スコア16996
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
あなたの回答
tips
太字
斜体
打ち消し線
見出し
引用テキストの挿入
コードの挿入
リンクの挿入
リストの挿入
番号リストの挿入
表の挿入
水平線の挿入
プレビュー
質問の解決につながる回答をしましょう。 サンプルコードなど、より具体的な説明があると質問者の理解の助けになります。 また、読む側のことを考えた、分かりやすい文章を心がけましょう。
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2018/04/06 14:42