|
- Sub Macro1()
- Dim arr, brr, crr, d, i&, j%, k%, s%
- arr = Range("a8").CurrentRegion
- brr = Range("f1").CurrentRegion
- ReDim d(1 To UBound(brr, 2))
- ReDim crr(1 To UBound(arr), 1 To UBound(brr, 2))
- For j = 1 To UBound(brr, 2)
- Set d(j) = CreateObject("scripting.dictionary")
- For i = 1 To UBound(brr)
- d(j)(brr(i, j)) = ""
- Next
- Next
- For i = 1 To UBound(arr)
- For j = 1 To UBound(brr, 2)
- s = 0
- For k = 1 To UBound(arr, 2)
- If d(j).exists(arr(i, k)) Then s = s + 1
- Next
- crr(i, j) = s
- Next
- Next
- Range("p8").Resize(UBound(crr), UBound(crr, 2)) = crr
- End Sub
复制代码 |
|