Sub aa()
'排序
arr = Range("D3:M9").Value
For i = 1 To UBound(arr, 1)
For j = 1 To UBound(arr, 2) - 1
For k = j + 1 To UBound(arr, 2)
If arr(i, k) < arr(i, j) Then
tmp = arr(i, j)
arr(i, j) = arr(i, k)
arr(i, k) = tmp
End If
Next
Next
Next
For i = 1 To UBound(arr, 1)
x = Cells(i + 2, 2)
f = False
s = arr(i, 1)
For j = 1 To UBound(arr, 2)
If arr(i, j) = x Then f = True '是否填充红色
If j > 1 Then '去重
If arr(i, j) <> arr(i, j - 1) Then
s = s & "," & arr(i, j)
End If
End If
Next
Set rg = Range("N" & (i + 2))
rg.Value = s
If f Then rg.Interior.ColorIndex = 3
Next
End Sub