21/03/17 10:52:25.95 KXbC8pO1H.net
>>960 なおした
Option Explicit
Sub VBA69_932_a()
Dim This As Worksheet
Dim table() As Variant
Dim A_number As Long, B_name As String, C_list As Object
Dim last_row As Long, row_loop As Long, search_loop As Long
Set C_list = CreateObject("Scripting.Dictionary")
Set This = ThisWorkbook.ActiveSheet
last_row = This.Range("A" & Rows.Count).End(xlUp).Row
ReDim table(last_row - 1, 2)
table = This.Range("A1:C" & last_row)
For row_loop = 1 To last_row
A_number = table(row_loop, 1)
C_list.RemoveAll
For search_loop = 1 To last_row
If table(search_loop, 1) = A_number Then
B_name = table(search_loop, 2)
If Not C_list.exists(B_name) Then
C_list.Add (B_name), 0
End If
End If
Next
table(row_loop, 3) = Join(C_list.keys, "・")
Next
This.Range("A1:C" & last_row) = table
End Sub