【VBA】元のシート内の文字列を別シートと比較し、一致したら元のシートの別のセルへ転記する方法。

VBAにて元のシート（集計表とします。）のF列に書かれてある部品名と比較したいシート（部品表とします。）のG列の部品名を比較し、部品名が一致すれば集計表のI列にある備考欄へ部品表のV列に書かれてある補足コメントをコピぺさせたいのですが、うまくいきません。少々ややこしいですがまとめますと、

１．集計表のF列（F12から）と部品表のG列（G8から）の名称の一致を検索
２．一致すれば集計表のI列（I12から）に部品表のV列（V8から）に書かれているコメントをコピぺする。

補足
集計表シートにある集計ボタンを押すと部品表の名称が被っている部品が一つに纏められて集計表に記載される仕組みとなっていて、各部品は1度しか出てきませんが、集計前の部品表には同じ部品が被って出てくる為行数が異なり、どう処理をすればいいか分かりません。

ご教授いただけますと幸いです。

No.2 ベストアンサー 回答者： 河内のおやじ 回答日時： 2023/03/23 17:37

VBAを使用して集計表と部品表の比較を行い、一致する部品名がある場合に備考欄に補足コメントをコピペするためのサンプルコードです。

集計表と部品表のシート名、およびセルの範囲に合わせて変更してください。
このコードでは、2重のループを使用して集計表と部品表の比較を行っています。まず、集計表のF列をループし、各部品名について部品表のG列をループして一致する部品名を検索します。一致した場合は、集計表の該当する行の備考欄に、部品表の対応する行の補足コメントをコピーします。部品表のループを抜けるために、Exit For文を使用しています。

この回答へのお礼

迅速な対応ありがとうございました！
おかげさまで簡単に処理ができました。
いただいたサンプルを参考に勉強させていただきます。

お礼日時：2023/03/23 18:24

No.3 回答者： 初心者ですが何か。 回答日時： 2023/03/23 18:10

＞部品表の名称が被っている部品が一つに纏められて集計表に記載される仕組みとなっていて、各部品は1度しか出てきません

＞集計前の部品表には同じ部品が被って出てくる為行数が異なり

となっていて、

＞部品名が一致すれば集計表のI列にある備考欄へ部品表のV列に書かれてある補足コメントをコピぺさせたいのです

の場合、補足コメントは複数行マッチしても同じ値なのでしょうか？

この回答へのお礼

コメント下さり、ありがとうございます。
コメントは同じとなっているため
先に回答くださった方のコードにて解決しました！
また機会がありましたらよろしくお願い致します。

お礼日時：2023/03/23 18:26

No.1 回答者： 河内のおやじ 回答日時： 2023/03/23 17:35

Sub CopyComments()

Dim wb As Workbook
Dim wsSummary As Worksheet
Dim wsParts As Worksheet
Dim lastRowSummary As Long
Dim lastRowParts As Long
Dim i As Long
Dim j As Long

Set wb = ThisWorkbook
Set wsSummary = wb.Worksheets("集計表") '集計表のシート名を指定
Set wsParts = wb.Worksheets("部品表") '部品表のシート名を指定

lastRowSummary = wsSummary.Cells(wsSummary.Rows.Count, "F").End(xlUp).Row '集計表の最終行を取得
lastRowParts = wsParts.Cells(wsParts.Rows.Count, "G").End(xlUp).Row '部品表の最終行を取得

For i = 12 To lastRowSummary '集計表のF列（F12から）をループ
For j = 8 To lastRowParts '部品表のG列（G8から）をループ
If wsSummary.Cells(i, "F").Value = wsParts.Cells(j, "G").Value Then '部品名が一致した場合
wsSummary.Cells(i, "I").Value = wsParts.Cells(j, "V").Value '備考欄に補足コメントをコピー
Exit For '部品表のループを抜ける
End If
Next j
Next i
End Sub