用VBA数组计算多列最大连续次数

laoau138

用VBA数组计算多列最大连续次数

grf1973

1. Sub 用VBA数组计算多列最大连续次数()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     arr = [g1:i22]: brr = [f25:i29]
   
4.     For j = 1 To UBound(arr, 2)
   
5.         d(Left(arr(1, j), 1) & Mid(arr(1, j), 3, 1)) = 1
   
6.         For i = 2 To UBound(arr)
   
7.             x = Left(arr(i, j), 1) & Mid(arr(i, j), 3, 1)
   
8.             x1 = Left(arr(i - 1, j), 1) & Mid(arr(i - 1, j), 3, 1)
   
9.             If x = x1 Then
   
10.                 s = s + 1
    
11.                 If s > d(x) Then d(x) = s
    
12.             Else
    
13.                 s = 1
    
14.             End If
    
15.         Next
    
16.         
    
17.         For i = 1 To UBound(brr)
    
18.             x = brr(i, 1)
    
19.             brr(i, j + 1) = IIf(d.exists(x), x & d(x), x & "1")
    
20.         Next
    
21.         d.RemoveAll
    
22.     Next
    
23.    
    
24.     [f25:i29] = brr
    
25. End Sub
    

复制代码

grf1973

换个思路。

1. Sub 用VBA数组计算多列最大连续次数()
   
2.     arr = [g1:i22]: brr = [f25:i29]
   
3.     With CreateObject("vbscript.regexp")
   
4.         .Global = True
   
5.         For j = 1 To UBound(arr, 2)
   
6.             s = Join(Application.Transpose(Application.Index(arr, , j)), "")
   
7.             .Pattern = "[金木水火土]"
   
8.             s = .Replace(s, "")
   
9.             For i = 1 To UBound(brr)
   
10.                 x = brr(i, 1)
    
11.                 .Pattern = "(" & x & ")+"
    
12.                 n = 0: Set ma = .Execute(s)
    
13.                 For Each m In ma
    
14.                     If n < Len(m) / 2 Then n = Len(m) / 2
    
15.                 Next
    
16.                 brr(i, j + 1) = x & n
    
17.             Next
    
18.         Next
    
19.     End With
    
20.     [f25:i29] = brr
    
21. End Sub

复制代码

laoau138

grf1973 发表于 2017-2-6 14:49
换个思路。

正则也出来了

laoau138

grf1973 发表于 2017-2-6 14:49
换个思路。

请VBA高手解析一下，这个brr(i)=0代表什么，用brr(i)=1难道不可以


http://www.excelpx.com/thread-427539-1-1.html


Sub tt()
    arr = Range("c11:c" & [c65536].End(3).Row)
    x = [j10]
    Dim brr(1 To 6)
    For i = 1 To 6
        brr(i) = 0    '请VBA高手解析一下，这个brr(i)=0代表什么，用brr(i)=1难道不可以
    Next
    For i = 1 To UBound(arr) - 1
        If arr(i, 1) = x Then brr(arr(i + 1, 1)) = brr(arr(i + 1, 1)) + 1
    Next
    [J13].Resize(, 6) = brr
End Sub