Sub A列項目の種類別に、B列項目を取りまとめる()
Dim wsSource As Worksheet
Dim wsDestination As Worksheet
Dim lastRow As Long
Dim uniqueValues As Collection
Dim cell As Range
Dim key As Variant
Dim result As String
' ソースシートと宛先シートを指定
Set wsSource = ThisWorkbook.Sheets("Sheet1") ' ソースシートの名前を適切に変更
Set wsDestination = ThisWorkbook.Sheets("Sheet2") ' 宛先シートの名前を適切に変更
' ソースシートの最終行を取得
lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
' ユニークな値を格納するコレクションを作成
Set uniqueValues = New Collection
' ソースシートのA列の値をユニークなものだけコレクションに追加
On Error Resume Next
For Each cell In wsSource.Range("A2:A" & lastRow)
uniqueValues.Add cell.Value, CStr(cell.Value)
Next cell
On Error GoTo 0
' 宛先シートをクリア
wsDestination.Cells.Clear
' コレクション内の各ユニークな値に対して処理
For Each key In uniqueValues
result = ""
' ソースシートを検索し、同じキーを持つ行のB列の値を結合
For Each cell In wsSource.Range("A2:A" & lastRow)
If cell.Value = key Then
If result <> "" Then
result = result & ", " ' カンマで値を区切る（TextJoin関数の場合、デリミタはカンマとなる）
End If
result = result & cell.Offset(0, 1).Value ' B列の値を結合
End If
Next cell
' 宛先シートに結合結果を書き込む
wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp).Offset(1, 0).Value = key
wsDestination.Cells(wsDestination.Rows.Count, "B").End(xlUp).Offset(1, 0).Value = result
Next key
End Sub
A列項目の種類別に、B列項目を取りまとめる
