重复名称及金额中提取唯一值

风向标----~

boyuanoffice 发表于 2024-5-28 10:39

谢谢，测试了，就是我想要的结果，谢谢呀~

zhangcheng6688

学习一下字典，打扰了
Sub test()
arr = [b2].CurrentRegion
Set d = CreateObject("scripting.dictionary")
For i = 2 To UBound(arr)
   If Not d.exists(arr(i, 1)) Then
      d(arr(i, 1)) = arr(i, 2)
   Else
      If InStr(d(arr(i, 1)), arr(i, 2)) = 0 Then
         d(arr(i, 1)) = d(arr(i, 1)) & "," & arr(i, 2)
      End If
   End If
Next
brr = [f2].CurrentRegion
Range("g:g").NumberFormat = "@"
For i = 2 To UBound(brr)
   brr(i, 2) = d(brr(i, 1))
Next
[f2].CurrentRegion = brr
End Sub