Option Explicit
Sub 宏1()
Dim arr1, arr2, i&, j&, x&, y&, ok
arr1 = Range("a2:g20")
arr2 = Range("i2:o6")
For i = 1 To UBound(arr2)
arr2(i, 7) = ""
For x = 1 To UBound(arr1)
ok = 0
For y = 1 To UBound(arr1, 2)
For j = 1 To UBound(arr2, 2)
If arr2(i, j) <> "" And arr1(x, y) = arr2(i, j) Then
ok = 1
Exit For
End If
Next j
If ok = 1 Then Exit For
Next y
If ok = 1 Then arr2(i, 7) = arr2(i, 7) & arr1(x, 1) & ","
Next x
If arr2(i, 7) <> "" Then arr2(i, 7) = Left(arr2(i, 7), Len(arr2(i, 7)) - 1)
Next i
Range("i2:o6") = arr2
End Sub
Sub 宏1()
Dim arr1, arr2, i&, j&, x&, y&, ok
arr1 = Range("a2:g20")
arr2 = Range("i2:o6")
For i = 1 To UBound(arr2)
arr2(i, 7) = ""
For x = 1 To UBound(arr1)
ok = 0
For y = 1 To UBound(arr1, 2)
For j = 1 To UBound(arr2, 2)
If arr2(i, j) <> "" And arr1(x, y) = arr2(i, j) Then
ok = 1
Exit For
End If
Next j
If ok = 1 Then Exit For
Next y
If ok = 1 Then arr2(i, 7) = arr2(i, 7) & arr1(x, 1) & ","
Next x
If arr2(i, 7) <> "" Then arr2(i, 7) = Left(arr2(i, 7), Len(arr2(i, 7)) - 1)
Next i
Range("i2:o6") = arr2
End Sub