去重覆统计个数问题

jylai

花没有了，明天送

zhangcheng6688

学习一下字典
Sub test()
lastr = Cells(Rows.Count, "a").End(xlUp).Row
arr = Range("a1:e" & lastr)
Set d = CreateObject("scripting.dictionary")
For i = 3 To UBound(arr, 2)
   If Not d.exists(arr(1, i)) Then
      Set d(arr(1, i)) = CreateObject("scripting.dictionary")
   End If
   For j = 2 To UBound(arr)
      If arr(j, i) = 1 Then
         d(arr(1, i))(arr(j, 1)) = ""
      End If
   Next
Next
lastr = Cells(Rows.Count, "g").End(xlUp).Row
brr = Range("g1:h" & lastr)
For i = 1 To UBound(brr)
   If d.exists(brr(i, 1)) Then
      brr(i, 2) = d(brr(i, 1)).Count
   Else
      brr(i, 2) = 0
   End If
Next
[g1].Resize(UBound(brr), UBound(brr, 2)) = brr
End Sub