用VBA计算D列连续属性总次数

laoau138

用VBA计算D列连续属性总次数

grf1973

1. Sub grf1()
   
2.     arr = Range("a1:a" & [a65536].End(3).Row)
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     p = 1
   
5.     For i = 1 To UBound(arr) - 1
   
6.         x = Left(arr(i, 1), 1) & Mid(arr(i, 1), 3, 1)
   
7.         For j = i + 1 To UBound(arr)
   
8.             y = Left(arr(j, 1), 1) & Mid(arr(j, 1), 3, 1)
   
9.             If y <> x Then Exit For
   
10.         Next
    
11.         p = j - i
    
12.         xkey = x & p
    
13.         d(xkey) = d(xkey) + 1
    
14.         i = j - 1
    
15.     Next
    
16.     brr = Range("d1:e" & [d65536].End(3).Row)
    
17.     For i = 1 To UBound(brr)
    
18.         brr(i, 2) = d(brr(i, 1))
    
19.     Next
    
20.     [e1].Resize(i - 1, 1) = Application.Index(brr, , 2)
    
21. End Sub
    

复制代码

grf1973

请看附件

laoau138

grf1973 发表于 2016-10-15 10:18
请看附件

改动一点点

VBA计算D列连续属性总次数再化简

grf1973

1. Sub grf1()
   
2.     arr = Range("a2:a" & [a65536].End(3).Row)
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     p = 1
   
5.     For i = 1 To UBound(arr) - 1
   
6.         x = Left(arr(i, 1), 1) & Mid(arr(i, 1), 3, 1)
   
7.         For j = i + 1 To UBound(arr)
   
8.             y = Left(arr(j, 1), 1) & Mid(arr(j, 1), 3, 1)
   
9.             If y <> x Then Exit For
   
10.         Next
    
11.         p = j - i
    
12.         xkey = x & p
    
13.         d(xkey) = d(xkey) + 1
    
14.         i = j - 1
    
15.     Next
    
16.     brr = Range("b2:e" & [b65536].End(3).Row)
    
17.     For i = 1 To UBound(brr)
    
18.         brr(i, 4) = d(brr(i, 1) & brr(i, 2))
    
19.     Next
    
20.     [e2].Resize(i - 1, 1) = Application.Index(brr, , 4)
    
21. End Sub
    

复制代码