|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
Sub test()
Set d = CreateObject("scripting.dictionary")
arr = [a1].CurrentRegion
For j = 2 To UBound(arr)
str1 = arr(j, 2) & arr(j, 3) & arr(j, 4) & arr(j, 5)
d(str1) = d(str1) & "," & j
Next j
For Each kk In d.keys
brr = Split(d(kk), ",")
If UBound(brr) > 1 Then
For i = 1 To UBound(brr)
str1 = arr(Val(brr(i)), 5) & ":" & arr(Val(brr(i)), 1)
For k = 1 To UBound(brr)
If i <> k Then
str1 = str1 & "、" & arr(Val(brr(k)), 1)
End If
Next k
arr(Val(brr(i)), 6) = str1 & "重复"
Next i
Else
arr(Val(brr(1)), 6) = "无重复"
End If
Next kk
[a1].CurrentRegion = arr
End Sub
|
|