Excel 別ブックから該当データを検索、必要データを元ブックへ転記する方法について

Question

「商品別部品一覧表」という元ブックがあります。
Ａ列：コード　Ｂ列：部品名　が入力されています。
(Ｃ列以降も入力がありますが今回は関係ないので省略します。)
　　　　Ａ列　　　　Ｂ列
2行目　コード　　　部品名
　　　 12345678　 ﾓｰﾀｰ
　　　 87654321　 電線

「リスト」という別ブックがあり、Ａ列：コード　Ｂ列：商品名　が入力されています。
　　　　Ａ列　　　　Ｂ列
4行目　コード　　　商品名
　　　 12345678　 ﾓｰﾀｰ(200V)
　　　 87654321　 電線(2sq)

やりたいことは「リスト」のコードから「商品別部品一覧表」のコードと一致するコードを検索し、
該当「リスト」のコードと同行にある商品名を「商品別部品一覧表」の部品名への転記です。


Sub データ検索転記()
  Dim I As Long
  Dim xlBook
  Set xlBook = Workbooks.Open("リスト")
  I = 5
  Do While Range("A" & I).Value <> ""
    ThisWorkbook.Worksheets("リスト").Range("A" & I).Value = Application.VLookup(ThisWorkbook.Worksheets("リスト").Range("A" & I).Value, xlBook.Worksheets("Sheet1").Range("A2:B65535"), 2, 0)
    I = I + 1
  Loop
  xlBook.Close
  MsgBox ("完了")
End Sub

上記のように他のサイトに記載されていたものを自分で訳して変更しつつやってみましたが解釈が名違っているのか上手くいきません。
社内にExcel関係が強い方がおらず、私一人がデータ入力の効率化を任されてしまった為
どのようにすればよいのかわかりません。
大変初歩的な質問で申し訳ないのですが、どなたかごご指導いただけないでしょうか？

tatsumaru77 · Accepted Answer

以下のマクロを標準モジュールに登録してください。

Option Explicit

Sub データ検索転記()
    Dim maxrow1 As Long
    Dim maxrow2 As Long
    Dim wrow As Long
    Dim dicT As Object
    Dim xlBook As Workbook
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim key As Variant
    Dim fname As String
    Set dicT = CreateObject("Scripting.Dictionary")
    fname = ThisWorkbook.Path & "\" & "リスト.xlsx"
    Set xlBook = Workbooks.Open(fname)
    Set ws1 = xlBook.Worksheets("リスト")
    maxrow1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row    '最大行取得
    For wrow = 5 To maxrow1
        key = ws1.Cells(wrow, "A").Value
        dicT(key) = ws1.Cells(wrow, "B").Value
    Next
    Set ws2 = ThisWorkbook.Worksheets("商品名")
    maxrow2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row    '最大行取得
    For wrow = 3 To maxrow2
        key = ws2.Cells(wrow, "A").Value
        If dicT.exists(key) = True Then
            ws2.Cells(wrow, "B").Value = dicT(key)
        Else
            ws2.Cells(wrow, "B").Value = False
        End If
    Next
    xlBook.Close
    MsgBox ("完了")
End Sub

tatsumaru77 · Answer

No5です。
誤記訂正します。
誤　C:\Users\xxxxxx\Desktop\.xlsx
正　C:\Users\xxxxxx\Desktop\リスト.xlsx

というファイル名をfnameに格納しています。

tatsumaru77 · Answer

Set dicT = CreateObject("Scripting.Dictionary")
これは、Dictionaryオブジェクト（連想配列）を作成しています。
Dictionaryオブジェクトについては、下記URLを参照ください。
https://www.sejuku.net/blog/29736
https://hirachin.com/post-3000/
Dictionaryオブジェクトは覚えておくとかなり有効な武器になります。
ぜひ、マスターしてください。

fname = ThisWorkbook.Path & "\" & "リスト.xlsx"
フルパスのファイル名を作成しています。
ファイルのオープンはフルパスでないとエラーが発生するケースが多々ありますので、フルパスで指定するようにしてください。

ThisWorkbook.Pathがマクロのあるファイルの格納フォルダになります。
今回はデスクトップ上にあるので
C:\Users\xxxxxx\Desktop
のような値になるはずです。（xxxxxxはあなたのユーザー名）
これに \　と　リスト.xlsxをつけて
C:\Users\xxxxxx\Desktop\.xlsx
というファイル名をfnameに格納しています。

tatsumaru77 · Answer

>どういったエラーなのか分からないのですが
>修正は可能でしょうか？

すみません。こちらでは、エラーになっていません。

考えられるのは、
コピペでなく、この行を手打ちで打ち込んだのでしょうか。
もしそうであれば、打ち間違いの可能性があります。

また、私が、提示したマクロにあなたがなにか他の行を追加（もしくは変更等）していて、
実際のマクロが提示した内容と違っていることはないでしょうか。
その影響で、エラーが発生しているのかも知れません。

tatsumaru77 · Answer

補足要求の追加です。
５．「リスト」ブックは、「商品別部品一覧表」ブックと同じフォルダ内にありますか。

６．マクロ実行後に
「商品別部品一覧表」のB列は、
ﾓｰﾀｰ
電線
になれば良いのですか。
それとも
ﾓｰﾀｰ(200V)
電線(2sq)
になれば良いですか。どちらでしょうか。

７．「商品別部品一覧表」のコードが「リスト」に存在しない場合、
B列にはなにを設定すれば良いのでしょうか。

tatsumaru77 · Answer

補足要求です。
１．マクロがあるのは、商品別部品一覧表の元ブックでしょうか。
２．商品別部品一覧表のシート名はなんでしょうか。
３．「リスト」ブックの拡張子は何でしょうか。（.xlsxですか）
４．「リスト」ブックのシート名は「リスト」であってますか。

Excel 別ブックから該当データを検索、必要データを元ブックへ転記する方法について

以下のマクロを標準モジュールに登録してください。

No5です。

Set dicT = CreateObject("Scripting.Dictionary")

>どういったエラーなのか分からないのですが

補足要求の追加です。

補足要求です。

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング