[已解决]求数组元素连续个数最大值和最大值个数的代码

爱疯

1. 
   
2. Sub test()
   
3.     Dim A, m%, n%, i%, x$, y$, arr, brr
   
4.     A = Array(0, 1, 1, 1, 0, 0, 2, 2, 1, 3, 3, 0, 0, 1, 1, 1, 2, 3, 0, 2)
   
5.     m = Application.Min(A)
   
6.     n = Application.Max(A)
   
7.     x = Replace(Join(A), " ", "")
   
8.     ReDim arr(m To n)
   
9.     ReDim brr(m To n)
   
10.     For i = m To n
    
11.         y = pd(x, i)
    
12.         arr(i) = Split(y, ",")(0)
    
13.         brr(i) = Split(y, ",")(1)
    
14.     Next i
    
15.     Stop
    
16. End Sub
    
17. 
    
18. Function pd(x, i) As String    '判断
    
19.     Dim regex As Object, matchs As Object, match As Object
    
20.     Dim k As Integer, j As Integer
    
21.     Set regex = CreateObject("VBScript.RegExp")
    
22.     With regex
    
23.         .Global = True
    
24.         .Pattern = i & "{2,}"
    
25.         Set matchs = .Execute(x)
    
26.         For Each match In matchs
    
27.             j = j + 1
    
28.             k = Application.Max(k, Len(match))
    
29.         Next
    
30.     End With
    
31.     pd = k & "," & j
    
32. End Function

复制代码

这样吗

haiyang81

回复 爱疯 的帖子

正是我所要的，非常感谢。

liuguansky

我的代码不用循环后面的字典KEY就可以了
此时：
KEYS为不重复值的数组
ITEMS为连续最大值与对应出现次数的二维数组。

haiyang81

1、Arr = Array(0, 1, 1, 1, 0, 0, 2, 2, 1, 3, 3, 0, 0, 1, 1, 1, 2, 3, 0, 2) 数组经常发生变化。我的数据主要是引用单元格区域，然后用Application.Transpose转换。这一点大家的程序都很好修改。
2、i的值发生变化，也就是统计单元格区域的某一数值得个数。有的时候是0到4，有的时候是1 到 7等等。
回头我再好好研究研究大家的代码。
总之，非常感谢大家的帮助。

liuguansky

回复 haiyang81 的帖子

我的代码的ARR直接定义赋值成你要处理的数组的。
另外也很好修改我的那个代码成自定义函数。
主要是你要明确自己已知什么结果，要返回什么结果就可以了。
你的结果可以返回成一个二维数组。对应多行三列。
第一列为不重复数组元素，第二列为最大连续数目，第三列为最大连续数出现的次数
如果用一个自定义函数来返回一个数组的话
可以把我的代码的D.exists判断部分略加变化返回到结果数组就可以了。

爱疯

看清了liuguansky的方法后（3楼）后，我才发现：

题意A：连续出现的最大值及出现连续最大值的次数
题意B：连续出现的最大值及出现连续值的次数

所以，我16楼其实题意B。如果是要题意A得改，比如如下：

1. 
   
2. Sub test()
   
3.     Dim A, m%, n%, i%, x$, y$, arr, brr
   
4.     A = Array(0, 1, 1, 1, 0, 0, 2, 2, 1, 3, 3, 0, 0, 1, 1, 1, 2, 3, 0, 2)
   
5.     m = Application.Min(A): n = Application.Max(A)
   
6.     ReDim arr(m To n): ReDim brr(m To n)
   
7.     x = Join(A, "")
   
8.     For i = m To n
   
9.         y = pd(x, i)
   
10.         arr(i) = Split(y, ",")(0)    'arr(i)表示匹配项的长度(即连续最大值)
    
11.         brr(i) = Split(y, ",")(1)    'brr(i)表示连续最大值的出现次数
    
12.     Next i
    
13.     Stop
    
14. End Sub
    
15. 
    
16. Function pd(x, i) As String    '判断
    
17.     Dim regex As Object, matchs As Object, match As Object
    
18.     Dim k As Integer, s As Integer
    
19.     Set regex = CreateObject("VBScript.RegExp")
    
20.     With regex
    
21.         .Global = True
    
22.         .Pattern = i & "{2,}"
    
23.         Set matchs = .Execute(x)
    
24.         For Each match In matchs
    
25.             If match.Length = k Then    'k表示匹配项的长度(即连续最大值)
    
26.                 s = s + 1       's表示连续最大值的出现次数
    
27.             ElseIf Len(match) > k Then
    
28.                 k = match.Length
    
29.                 s = 1    '因为产生了新的最大值，所以s重新计数
    
30.             End If
    
31.         Next
    
32.     End With
    
33.     pd = k & "," & s
    
34. End Function
    

复制代码

MhPrykRa.zip (15.39 KB, 下载次数: 6)

2011-11-6 22:12 上传

点击文件名下载附件

比如，在 Array 数组中的末尾加入连续4个0。变成：
    Arr = Array(0, 1, 1, 1, 0, 0, 2, 2, 1, 3, 3, 0, 0, 1, 1, 1, 2, 3, 0, 2, 0, 0, 0, 0)

3楼结果就不对了，不知为什么？
liuguansky的数组+字典用得很好、很紧凑。我理解得还不顺溜，不知说的对吗。附件中，模块1是3楼，模块2是我用题意A修改的。

爱疯

爱疯 发表于 2011-11-4 18:05
看清了liuguansky的方法后（3楼）后，我才发现：

题意A：连续出现的最大值及出现连续最大值的次数

由于1楼条件正巧，造成两个巧合：

1）使得两种题意得到相同结果。所以，有的理解为A，有的理解为B。

2）3楼思路：发生不连续时，才统计上一次的key。如果最后是连续相等的，就没被统计了。正巧，1楼条件中倒数第2和最后不同，没被发现。

haiyang81

回复 爱疯 的帖子

其实我是要题意A的。我还真没有注意运行完程序的结果。

爱疯

我也是无意中发现的。
liuguansky的方法难度高些，我很难做到，看了liuguansky的方法，对数组+字典增加了认识，学习了。

haiyang81

回复 爱疯 的帖子

主要是初学者，所以你的方法还是没能融会贯通。又遇到新问题了。
若是求arr=array(0,1,1,1,0,0,2,2,1,3,3,0,0,1,1,1,2,3,0,2)最后一个元素的连续最大值及出现连续最大值的次数。
结果为pd=Array(2,2,1)
若是数组为Arr = Array(0, 1, 1, 1, 0, 0, 2, 2, 1, 3, 3, 0, 0, 1, 1, 1, 2, 3, 0, 2, 0, 0, 0, 0)，
则结果为pd=Array(0,4,1)
则你的代码该如何修改。