[已解决]条件的三行单元格包含相同数的个数

hhaa999

三行单元格包含相同数的个数

最佳答案

月排行榜 / 总排行榜

dsmch

2014-11-9 16:35

………………

跳转到最佳答案楼层

dsmch

1. Sub Macro1()
   
2. Dim arr, brr, crr, d, d2,i&,k%,j%,zf$$
   
3. Set d = CreateObject("scripting.dictionary")
   
4. Set d2 = CreateObject("scripting.dictionary")
   
5. arr = Range("a1").CurrentRegion
   
6. brr = Range("i3:i" & Range("i65536").End(xlUp).Row)
   
7. ReDim crr(1 To UBound(brr), 1 To 2)
   
8. For i = 2 To UBound(arr)
   
9.     d(arr(i, 1)) = i
   
10. Next
    
11. For i = 1 To UBound(brr) - 1
    
12.     x = Split(brr(i, 1), "-"): p = ""
    
13.     For j = 0 To UBound(x)
    
14.         n = d(Val(x(j))) + 1
    
15.         For k = 2 To UBound(arr, 2)
    
16.             d2(arr(n, k)) = d2(arr(n, k)) + 1
    
17.             If d2(arr(n, k)) = UBound(x) + 1 Then p = p & "," & arr(n, k)
    
18.         Next
    
19.     Next
    
20.     zf = Mid(p, 2)
    
21.     crr(i, 1) = zf
    
22.     crr(i, 2) = UBound(Split(zf, ",")) + 1
    
23.     d2.RemoveAll
    
24. Next
    
25. Range("j3").Resize(UBound(crr), 2) = crr
    
26. End Sub

复制代码

dsmch

………………