Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 17159|回复: 58

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

  [复制链接]
发表于 2011-11-4 11:19 | 显示全部楼层 |阅读模式
若有一数组arr=array(0,1,1,1,0,0,2,2,1,3,3,0,0,1,1,1,2,3,0,2),求0,1,2,3连续的最大值及个数代码。
结果为0的连续最大值为2,出现次数2次
            1的连续最大值为3,出现次数2次
            2的连续最大值为2,出现次数1次
            3的连续最大值为2,出现次数1次。


若是借助单元格,用Application.Evaluate("MAX(FREQUENCY(IF(A1:A20=0,ROW(A1:A20)),IF(A1:A20<>0,ROW(A1:A20))))")可以求连续最大值;用Application.Evaluate(“SUM((FREQUENCY(IF(A1:A20=3,ROW(A1:A20)),IF(A1:A20<>3,ROW(A1:A20)))=MAX(FREQUENCY(IF(A1:A20=3,ROW(A1:A20)),IF(A1:A20<>3,ROW(A1:A20)))))*1)”)可以求个数。但数据越多,感觉运行速度越慢,有没有更好的办法,不用借助单元格套用公式?


最佳答案
2011-11-4 12:04
  1. 'arr=array(0,1,1,1,0,0,2,2,1,3,3,0,0,1,1,1,2,3,0,2),
  2. '0的连续最大值为2,出现次数2次
  3. Sub JustTest()
  4.     Dim Arr, i&, k&, d, str, ar
  5.     Set d = CreateObject("scripting.dictionary")
  6.     Arr = Array(0, 1, 1, 1, 0, 0, 2, 2, 1, 3, 3, 0, 0, 1, 1, 1, 2, 3, 0, 2)
  7.     k = 1
  8.     For i = LBound(Arr) + 1 To UBound(Arr)
  9.         If Arr(i) = Arr(i - 1) Then
  10.             k = k + 1
  11.         Else
  12.             If d.exists(Arr(i - 1)) Then
  13.                 ar = d(Arr(i - 1))
  14.                 If ar(0) = k Then
  15.                     ar(1) = ar(1) + 1
  16.                 ElseIf ar(0) < k Then
  17.                     ar(0) = k: ar(1) = 1
  18.                 End If
  19.                 d(Arr(i - 1)) = ar
  20.             Else: d.Add Arr(i - 1), Array(k, 1)
  21.             End If
  22.             k = 1
  23.         End If
  24.     Next
  25.     Arr = d.keys
  26.     For i = LBound(Arr) To UBound(Arr)
  27.         str = str & vbCrLf & i & "的连续最大值为" & d(i)(0) & ",出现次数为" & d(i)(1) & "次"
  28.     Next i
  29.     MsgBox "数组中的元素连续情况为:" & str
  30.     Set d = Nothing
  31. End Sub
复制代码

运行结果 :
QQ截图20111104120331.png
示例文件如下:
新建 Microsoft Excel 97-2003 工作表.rar (9.53 KB, 下载次数: 62)
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2011-11-4 11:57 | 显示全部楼层
本帖最后由 liuts 于 2011-11-4 11:58 编辑


  1. Sub test()
  2. '先引用正则控件,方法:工具-引用-"Microsoft VBsrcipt Regular EXpression 5.5"
  3.     Dim reg As New RegExp, sr, arr, str
  4.     arr = Array(0, 1, 1, 1, 0, 0, 2, 2, 1, 3, 3, 0, 0, 1, 1, 1, 2, 3, 0, 2)
  5.     sr = Join(arr, "")
  6.     For i = 0 To 3
  7.         For j = Len(sr) To 1 Step -1
  8.             str = "(" & i & "){" & j & "}"
  9.             With reg
  10.                 .Global = True
  11.                 .Pattern = str
  12.                 If .test(sr) = True Then
  13.                     MsgBox i & ":最大次数是:" & j & "次"
  14.                     Exit For
  15.                 End If
  16.             End With
  17.         Next
  18.     Next
  19. End Sub
复制代码

回复

使用道具 举报

发表于 2011-11-4 12:04 | 显示全部楼层    本楼为最佳答案   
  1. 'arr=array(0,1,1,1,0,0,2,2,1,3,3,0,0,1,1,1,2,3,0,2),
  2. '0的连续最大值为2,出现次数2次
  3. Sub JustTest()
  4.     Dim Arr, i&, k&, d, str, ar
  5.     Set d = CreateObject("scripting.dictionary")
  6.     Arr = Array(0, 1, 1, 1, 0, 0, 2, 2, 1, 3, 3, 0, 0, 1, 1, 1, 2, 3, 0, 2)
  7.     k = 1
  8.     For i = LBound(Arr) + 1 To UBound(Arr)
  9.         If Arr(i) = Arr(i - 1) Then
  10.             k = k + 1
  11.         Else
  12.             If d.exists(Arr(i - 1)) Then
  13.                 ar = d(Arr(i - 1))
  14.                 If ar(0) = k Then
  15.                     ar(1) = ar(1) + 1
  16.                 ElseIf ar(0) < k Then
  17.                     ar(0) = k: ar(1) = 1
  18.                 End If
  19.                 d(Arr(i - 1)) = ar
  20.             Else: d.Add Arr(i - 1), Array(k, 1)
  21.             End If
  22.             k = 1
  23.         End If
  24.     Next
  25.     Arr = d.keys
  26.     For i = LBound(Arr) To UBound(Arr)
  27.         str = str & vbCrLf & i & "的连续最大值为" & d(i)(0) & ",出现次数为" & d(i)(1) & "次"
  28.     Next i
  29.     MsgBox "数组中的元素连续情况为:" & str
  30.     Set d = Nothing
  31. End Sub
复制代码

运行结果 :
QQ截图20111104120331.png
示例文件如下:
新建 Microsoft Excel 97-2003 工作表.rar (9.53 KB, 下载次数: 62)
回复

使用道具 举报

发表于 2011-11-4 12:06 | 显示全部楼层
这里高手好多啊。大家多教教我啊
回复

使用道具 举报

 楼主| 发表于 2011-11-4 12:07 | 显示全部楼层
高手啊。
0的连续最大值为2,1的连续最大值为3,2的连续最大值为2,3的连续最大值为2,这几个值如何表示。
回复

使用道具 举报

 楼主| 发表于 2011-11-4 12:12 | 显示全部楼层
回复 liuts 的帖子

高手啊。
0的连续最大值为2,1的连续最大值为3,2的连续最大值为2,3的连续最大值为2,这几个值如何表示。
回复

使用道具 举报

发表于 2011-11-4 12:19 | 显示全部楼层
  1. Sub 重复()
  2. Dim d As Object
  3. Dim Arr, x, k, n, arr2
  4. Set d = CreateObject("scripting.dictionary")
  5. Arr = Array(0, 1, 1, 1, 0, 2, 2, 1, 3, 3, 0, 1, 1, 1, 2, 3, 0, 2)
  6. For x = 0 To UBound(Arr) - 1
  7.    Do While Arr(x + 1) = Arr(x)
  8.      x = x + 1
  9.      k = k + 1
  10.    Loop
  11.    If d.exists(Arr(x)) Then
  12.       If d(Arr(x)) < k + 1 Then
  13.         d(Arr(x)) = k + 1
  14.       End If
  15.     Else
  16.       d(Arr(x)) = k + 1
  17.     End If
  18.     k = 0
  19. Next x
  20. Range("a1").Resize(d.Count) = Application.Transpose(d.keys)
  21. Range("b1").Resize(d.Count) = Application.Transpose(d.items)
  22. End Sub
复制代码

点评

结果有误 吧。而没有显示次数哦。兰版。  发表于 2011-11-4 12:31
回复

使用道具 举报

发表于 2011-11-4 12:32 | 显示全部楼层
本帖最后由 兰色幻想 于 2011-11-4 12:33 编辑

还要出现的次数啊{:031:}
回复

使用道具 举报

发表于 2011-11-4 12:38 | 显示全部楼层
  1. Sub 重复()
  2. Dim d As Object, d1 As Object
  3. Dim Arr, x, k, n, arr2
  4. Set d = CreateObject("scripting.dictionary")
  5. Set d1 = CreateObject("scripting.dictionary")
  6. Arr = Array(0, 1, 1, 1, 0, 2, 2, 1, 3, 3, 0, 1, 1, 1, 2, 3, 0, 2)
  7. For x = 0 To UBound(Arr) - 1
  8.    Do While Arr(x + 1) = Arr(x)
  9.      x = x + 1
  10.      k = k + 1
  11.    Loop
  12.    If d.exists(Arr(x)) Then
  13.       d1(Arr(x)) = d1(Arr(x)) + 1
  14.       If d(Arr(x)) < k + 1 Then
  15.         d(Arr(x)) = k + 1
  16.       End If
  17.     Else
  18.       d(Arr(x)) = k + 1
  19.       d1(Arr(x)) = 1
  20.     End If
  21.     k = 0
  22. Next x
  23. d1(Arr(x)) = d1(Arr(x)) + 1
  24. Range("a1").Resize(d.Count) = Application.Transpose(d.keys)
  25. Range("b1").Resize(d.Count) = Application.Transpose(d.items)
  26. Range("c1").Resize(d.Count) = Application.Transpose(d1.items)
  27. End Sub
复制代码

点评

1.第一位的处理应该初始化K=1 2.是最大连续出现的次数,不是总次数。  发表于 2011-11-4 12:45
回复

使用道具 举报

 楼主| 发表于 2011-11-4 12:44 | 显示全部楼层
liuts的代码缺少连续最大值。兰版、liuguansky能不能帮忙改一下。
数据多的时候,不知道 liuts   liuguansky的代码,谁的运行速度快。
正在学习liuts   liuguansky和兰版的代码。就是有差距啊,一比较就知道了,字典+数组运用还是不熟练。
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 20:41 , Processed in 0.472532 second(s), 8 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表