Sub wuya()
Set d = CreateObject("Scripting.Dictionary") '创建字典"d"
arr = Sheet3.UsedRange '把整个工作表赋值给数组 Sheet3修改成对应的工作表
'↓把1,2组姓名写入字典中
For i = 1 To 2
For n = 2 To UBound(arr)
If arr(n, i) <> "" Then
If d.exists(arr(n, i)) And d(arr(n, i)) <> i Then
d(arr(n, i)) = "1,2" '两组出现相同名字
Else
d(arr(n, i)) = i '将姓名添加到字典
End If
End If
Next n
Next i
'↓写入组别数据
For i = 2 To UBound(arr)
If arr(i, 4) <> "" Then
If d.exists(arr(i, 4)) Then
Cells(i, 5) = d(arr(i, 4))
Else
Cells(i, 5) = "无"
End If
End If
Next i
k = d.items
End Sub
这算是比较完善的方法,考虑到了一二组同名情况。有不懂可加Q:47436528