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

csmctjg · 发表于 2012-2-10 12:56

本帖最后由 csmctjg 于 2012-2-10 13:40 编辑

我也参加一下：

Sub aa()
Dim arr, i%, j%, k%, d As New Dictionary
arr = Array(0, 1, 1, 1, 0, 0, 2, 2, 1, 3, 3, 0, 0, 1, 1, 1, 2, 3, 0, 2)
ReDim brr(1 To UBound(arr) + 1, 1 To 3)
For i = 0 To UBound(arr)
k = arr(i)
Do While arr(i) = k
j = j + 1
i = i + 1
If i = UBound(arr) + 1 Then Exit Do
Loop
If Not d.Exists(k) Then d(k) = Array(0, 0)
If j > d(k)(0) Then
d(k) = Array(j, 1)
ElseIf j = d(k)(0) Then
d(k) = Array(j, d(k)(1) + 1)
End If
i = i - 1
j = 0
Next i
[A1].Resize(d.Count) = Application.Transpose(d.keys)
[B1].Resize(d.Count, 2) = Application.Transpose(Application.Transpose(d.Items))
End Sub

复制代码

haiyang81 · 发表于 2012-2-10 19:19

香川群子发表于 2012-2-10 11:12
前面所有人的代码，算法都不是很好……

如果【前提是，统计对象为数值0-9】

谢谢你的解答。
若仿照21#爱疯的结构，改成自定义函数，输入的是字符串或是数组，结果以数组的形式输出，该如何修改。
谢谢啦！

haiyang81 · 发表于 2012-2-10 19:22

香川群子发表于 2012-2-10 11:12
前面所有人的代码，算法都不是很好……

如果【前提是，统计对象为数值0-9】

我是学工商管理的，但是特别喜欢编程，基本的语法算是明白了。但其他方面差很多。
有没有比较好的算法结构的书推荐一下，或是其他的对提高编程有帮助的书推荐一下。
谢谢。感激不尽

香川群子 · 发表于 2012-2-10 21:27

csmctjg 发表于 2012-2-10 12:56
我也参加一下：

你的算法看上去不错……

但是，使用字典，并且字典Item对象还是数组Array()……

速度就很慢很慢了。

如果看速度，那么无疑我的纯数组方法是最快的。

运行1000次耗时0.1秒，而你的代码需要5秒多……比你快50倍。

香川群子 · 发表于 2012-2-10 21:29

haiyang81 发表于 2012-2-10 19:19
谢谢你的解答。
若仿照21#爱疯的结构，改成自定义函数，输入的是字符串或是数组，结果以数组的形式输出， ...

楼主希望有自定义函数代码，

那么我希望你提供附件，表明原始数据存放方式，

同时手工模拟你的结果要求。

上附件吧。

haiyang81 · 发表于 2012-2-10 22:10

香川群子发表于 2012-2-10 21:29
楼主希望有自定义函数代码，

那么我希望你提供附件，表明原始数据存放方式，

(, 下载次数: 8)

csmctjg · 发表于 2012-2-11 20:48

香川群子发表于 2012-2-10 21:27
你的算法看上去不错……

但是，使用字典，并且字典Item对象还是数组Array()……

对于此题，我没从速度上着眼，只是着眼于思路多样化，若要考虑速度，则尽量不用字典，除非万不得已！

FF7 · 发表于 2012-2-12 22:34

本帖最后由 FF7 于 2012-2-12 23:51 编辑

既然是研究算法，那我凑个热闹，支持爱疯的精华帖步伐。弄个纯数组运算：编辑提示：以下代码可延伸到计算0到9这10个数字最大连续及其次数的统计。

Sub xx()
Dim t As Integer, n As Integer, x As Integer, y As Integer, strA As String,a(),Arr
Arr = Array(0, 1, 1, 1, 0, 0, 2, 2, 1, 3, 3, 0, 0, 1, 1, 1, 2, 3, 0, 2)
t = 999
ReDim a(0 To 9, 0 To 1)
For i = 0 To UBound(Arr)
If Arr(i) <> t Then
t = Arr(i)
n = 1
If y < Arr(i) Then y = Arr(i)
Else
n = n + 1
If x < n Then x = n: ReDim Preserve a(0 To 9, 0 To x)
End If
If n > a(t, 0) Then a(t, 0) = n
a(t, n) = a(t, n) + 1
Next
For m = 0 To y
strA = strA & m & "最大连续" & a(m, 0) & "次，这种连续总共出现" & a(m, a(m, 0)) & "次。" & Chr(10)
Next
MsgBox strA
End Sub

复制代码

代码二：
统计数组中，所有元素最大连续及其出现的次数(数字和字母混编)：

Sub yy()
Dim dc As Object
Set dc = CreateObject("Scripting.dictionary")
Arr = Array(0, 1, 1, "A", "A", 1, 0, 0, 2, 2, "中", "中", "国", 1, 3, 3, 0, 0, 1, 1, 1, 2, 3, 0, 2, "A", "A", "B", "B", "C", "A", "A")
Dim i As Integer, n As Long, x As Integer
For i = 0 To UBound(Arr)
If Not dc.exists(Arr(i)) Then dc(Arr(i)) = n: n = n + 1
Next
b = dc.keys
Dim a()
ReDim a(0 To dc.Count, 0 To 1)
strA = ""
For i = 0 To UBound(Arr)
If Arr(i) <> strA Then
strA = Arr(i)
n = 1
Else
n = n + 1
If x < n Then x = n: ReDim Preserve a(0 To dc.Count, 0 To x)
End If
If n > a(dc(strA), 0) Then a(dc(strA), 0) = n
a(dc(strA), n) = a(dc(strA), n) + 1
Next
strA = "所有元素最大连续及其出现次数统计："
For i = 0 To UBound(b)
strA = strA & Chr(10) & b(i) & "--最大连续" & a(dc(b(i)), 0) & "次，其出现的次数为" & a(dc(b(i)), a(dc(b(i)), 0)) & "次"
Next
MsgBox strA
End Sub

复制代码

白米饭 · 发表于 2012-2-13 20:44

本帖最后由白米饭于 2012-2-13 20:45 编辑

高手真多，我想跟着学习，暂时还看不懂，留过记号

上清宫主 · 发表于 2012-2-13 21:55

本帖最后由上清宫主于 2012-2-13 21:58 编辑

这个帖子有意思，学习群子等各位大大的了！
37、39楼为什么非要For i = 0 To UBound(Arr) - 1？先将第0个处理掉，然后 For i =1 To UBound(Arr) 字符数可以少点、少点if。
48楼将redim整到循环中去，还是整出来好点

如代码一中当 Arr = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)时，数组a是怎样的？有意义吗？还有n已经起到记数的作用了，还需要每次都向数组a赋值？
不细数了。以上拙见，请别介意

其实我就是眼高手低，会说不会做

，向各位学习！

		自动登录	找回密码
密码			注册

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

点评