エクセル マクロVBAについて教えてください。

助けてください。
Excelは関数を少し使ってるくらいのVB全くわかってないレベルで恐縮なのですが
仕事で以下のファイルを作る必要があり
検索などで色々調べているものの見事につまづいております。

シート1のB列にある商品コード10桁の英数字の左から7桁をシート2にあるD列の商品コード10桁
と比較して7桁が一致しているところのG列の商品名をシート1のC列に貼り付けしたいのですが
やり方がわかりません。
説明がうまくできているかわかりませんが、詳しい方の回答よろしくお願いいたします。

質問者からの補足コメント

• 回答ありがとうございます。
  シート1はシート1でシート2は2で合っています。
  シート1の1行目は見出し、2行目はデータで合っています。
  大変恐縮なのですが、プログラム全体の書き方を参考にしたいので記載していただけるとありがたいです。
  宜しくお願いします。

  No.2の回答に寄せられた補足コメントです。 補足日時：2024/10/02 15:45

• ありがとうございます。
  これで試してみます。
  この、プログラムをほかの作成したシートで使用する場合は大文字のアルファベットを
  そのシートの列に変えればいいですか？
  また今回は2行目を指定していますが、違う行から探す時はどこを変更すればいいでしょうか？
  素人質問ばかりですみませんが回答お願いします。

  No.3の回答に寄せられた補足コメントです。 補足日時：2024/10/02 18:23

No.4 ベストアンサー 回答者： tatsumaru77 回答日時： 2024/10/02 18:53

No3です。

>この、プログラムをほかの作成したシートで使用する場合は大文字のアルファベットを
そのシートの列に変えればいいですか？

はい、それで結構です。シート名も変えてください。

>また今回は2行目を指定していますが、違う行から探す時はどこを変更すればいいでしょうか？

シート１の開始行を5行に変える場合、
For row1 = 2 To lastrow1　を
For row1 = 5 To lastrow1　のようにしてください。

シート2の開始行を6行に変える場合、
For row2 = 2 To lastrow2 を
For row2 = 6 To lastrow2 のようにしてください。

この回答へのお礼

素人質問に丁寧に回答していただき
大変解りやすかったです。
教えてもらったことを試していきたいと思います。
また、困ったことがあれば質問させてもらいます。
この度はありがとうございました。

お礼日時：2024/10/03 04:15

No.3 回答者： tatsumaru77 回答日時： 2024/10/02 16:03

No2です。

以下のマクロを標準モジュールに登録してください。
不明点があれば、補足してください。


Option Explicit
Public Sub 商品名設定()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim lastrow1 As Long
Dim lastrow2 As Long
Dim row1 As Long
Dim row2 As Long
Dim dicT As Object
Dim cd7 As String '商品コードの左7桁
Set ws1 = Worksheets("シート1")
Set ws2 = Worksheets("シート2")
Set dicT = CreateObject("Scripting.Dictionary") ' 連想配列の定義
lastrow1 = ws1.Cells(Rows.Count, "B").End(xlUp).row 'B列の最大行取得
lastrow2 = ws2.Cells(Rows.Count, "D").End(xlUp).row 'B列の最大行取得
For row2 = 2 To lastrow2
cd7 = Left(ws2.Cells(row2, "D").Value, 7)
If cd7 <> "" Then
If dicT.exists(cd7) = False Then
dicT(cd7) = ws2.Cells(row2, "G").Value
End If
End If
Next
For row1 = 2 To lastrow1
cd7 = Left(ws1.Cells(row1, "B").Value, 7)
ws1.Cells(row1, "C").ClearContents
If cd7 <> "" Then
If dicT.exists(cd7) = True Then
ws1.Cells(row1, "C").Value = dicT(cd7)
End If
End If
Next
MsgBox ("完了")
End Sub

No.2 回答者： tatsumaru77 回答日時： 2024/10/02 14:42

補足要求です。

１．シート1のシート名は、"シート1"であってますか。
２．シート2のシート名は、"シート2"であってますか。
３．シート1の１行目は、見出しで、データは２行目からでしょうか。（シート２も同様）

No.1 回答者： ssawatake 回答日時： 2024/10/02 14:10

色々考えずにゴリゴリ。

シート名をSheet1、Sheet2とする。

行END1 = WS1.Range("B65536").End(xlUp).Row '最終行取得

行END2 = WS2.Range("D65536").End(xlUp).Row '最終行取得

For 行1 = 1 To 行END1

For 行2 = 1 To 行END2

If Left(WS1.Range("B" & 行1).Value, 7) = Left(WS2.Range("D" & 行2).Value, 7) Then '先頭7桁が等しい場合は

WS1.Range("C" & 行1).Value = WS2.Range("G" & 行2).Value '転送

End If

Next 行2
Next 行1