- Sub test()
- Dim r&, arr, dic As Object, i&, j&, k&, brr1, brr2
- Set dic = CreateObject("scripting.dictionary")
- With Sheet2
- r = .Range("K1").End(xlDown).Row
- arr = .Range("AO2:AS" & r)
- For i = 1 To UBound(arr)
- For j = 1 To UBound(arr, 2)
- If arr(i, j) <> "" Then
- dic(arr(i, j)) = dic(arr(i, j)) + 1
- End If
- Next
- Next
- brr1 = dic.keys
- brr2 = dic.items
- For k = 3 To 12
- If IsEmpty(dic(CDbl(.Cells(k, "av")))) Then
- .Cells(k, "aw").Value = 0
- Else
- .Cells(k, "aw").Value = dic(CDbl(.Cells(k, "av")))
- End If
- Next
- End With
- End Sub
复制代码 |