IDが重複した場合、その他のデータを1行にまとめるvbaのコード

VBA素人で困っています。
WEB検索し色々と読みましたがいまいちわからず・・・
下記のようなコードを作りたく、お知恵を拝借できますでしょうか。
------
◆元データ
品番（キーID） 製品番号 形式　　　　車名 仕入金額
28100-30070 TYS190 KDH200 ハイエース 27500
28100-30070 TYS190 KDH227 ハイエース 27500
28100-30100 TYS190 KDH206 ハイエース 27500
28100-30070 TYS190 KDY280 ダイナ 27500
28100-30070 TYS190 KDH206 ハイエース 27500
28100-30070 TYS190 KDH205 ハイエース 27500
：
↓↓↓↓↓↓↓↓↓↓
品番（キーID） 製品番号 形式　　　　　　　　　　　　　　　　　　　　　　　車名 　仕入金額
28100-30070 TYS190 KDH200・KDH227・KDY280・KDH206・KDH205 ハイエース・ダイナ 27500
28100-30100 TYS190 KDH206 ハイエース 27500
※キーIDが同じ場合
　・形式を1つのセルにまとめる
　・車名を1つのセルにまとめる、重複する場合は1つにする
　・製品番号、仕入金額を1つのセルにまとめる（キーID
ID1つで同製品番号、同価格）
------
どなたかこのような動作を行うvbaのコードを教えてください。
よろしくお願いいたします。

No.1 ベストアンサー 回答者： fujillin 回答日時： 2021/06/05 18:26

こんばんは

回答がつかないようなので・・・

列の区切りがはっきりしませんけれど、A～E列に、品番、製品番号、形式、車名、仕入金額の5項目が存在するものと解釈しました。

品番をキーにして、各列の内容を「重複を省き、"・"を区切り文字として連結したい」ということと解釈しました。
結果をどこに表示するのかわからないので、同じシートに2行空けてそのまま下部に表示させています。

以下、ご参考までに。
（必ずしも効率が良い方法ではありませんけれど…）

Sub Sample_Q12394317()
Dim data, dic, rng As Range, keyID As String
Dim mxR As Long, rw As Long, i As Long, j As Long

Set dic = CreateObject("Scripting.Dictionary")
mxR = Cells(Rows.Count, 1).End(xlUp).Row
data = Range(Cells(2, 1), Cells(mxR, 5)).Value
rw = mxR + 3

Set rng = Cells(rw, 1).Resize(mxR - 1)
rng.Value = Cells(2, 1).Resize(mxR - 1).Value
rng.RemoveDuplicates Columns:=1, Header:=xlNo

While Cells(rw, 1) <> ""
　keyID = Cells(rw, 1).Value
　For j = 2 To 5
　　dic.RemoveAll
　　For i = 1 To mxR - 1
　　　If data(i, 1) = keyID Then
　　　　If Not dic.exists(data(i, j)) Then dic.Add data(i, j), 1
　　　End If
　　Next i
　　Cells(rw, j).Value = Join(dic.keys, "・")
　Next j
　rw = rw + 1
Wend
End Sub

この回答へのお礼

ありがとうございます。
こちらのコードで反映されました。
非常に助かりました！！！
（つたない説明にもかかわらずご対応ありがとうございました。）

お礼日時：2021/06/07 11:00