|
楼主 |
发表于 2014-12-8 19:27
|
显示全部楼层
Sub Macro1()
Dim arr, brr, crr, d, i&, j%, k%, s%
arr = Range("a8").CurrentRegion
brr = Range("p1").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
|
|