>>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
