[已解决]不重复数统计(怎样提速)

爱疯

2f0xfZTQ.rar (160.34 KB, 下载次数: 17)

2009-10-2 23:14 上传

点击文件名下载附件
不重复数统计(怎样提速)

说明：

A列，是随机数（0~1000）

C列，为A列不重复数；

D列，为对应C列的数，所出现的次数。

 

记得yy好像用什么方法可以避免双重循环（我觉得费时就费这了），从而大大提高速度。由于收藏的文件不在了。所以又来问。

请问，怎样修改能尽可能的快，并适用性好？

我只是按部就班做的，所以尽可放弃不用，另起炉灶[em04]

谢谢！

最佳答案

月排行榜 / 总排行榜

suye1010

2009-10-2 23:43

还可以在楼上的基础上取出arr1数组等于字典值的语句，这样又可以进一步提速O(∩_∩)O
Option Explicit

Sub 不重复数统计()
Dim i&, arr, t
Dim d As Object
t = Timer
Application.ScreenUpdating = False
Columns("C:D").ClearContents
arr = Range("A1:A" & Range("A65536").End(xlUp).Row)
    '求A列不重复数
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(arr)
    d(arr(i, 1)) = d(arr(i, 1)) + 1
Next i
[c1].Resize(d.Count, 1) = Application.Transpose(d.keys)
[d1].Resize(d.Count, 1) = Application.Transpose(d.items)
Application.ScreenUpdating = True
MsgBox Timer - t & "秒"
End Sub

跳转到最佳答案楼层

雨狐

p1Dciwml.rar (196.24 KB, 下载次数: 3)

2009-10-2 23:35 上传

点击文件名下载附件
不重复数统计(怎样提速)

suye1010

还可以在楼上的基础上取出arr1数组等于字典值的语句，这样又可以进一步提速O(∩_∩)O
Option Explicit

Sub 不重复数统计()
Dim i&, arr, t
Dim d As Object
t = Timer
Application.ScreenUpdating = False
Columns("C:D").ClearContents
arr = Range("A1:A" & Range("A65536").End(xlUp).Row)
    '求A列不重复数
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(arr)
    d(arr(i, 1)) = d(arr(i, 1)) + 1
Next i
[c1].Resize(d.Count, 1) = Application.Transpose(d.keys)
[d1].Resize(d.Count, 1) = Application.Transpose(d.items)
Application.ScreenUpdating = True
MsgBox Timer - t & "秒"
End Sub

爱疯

谢谢雨狐、suye1010！！

d(arr(i, 1)) = d(arr(i, 1)) + 1这句，原来：

=左边的d(arr(i, 1))表示key；

=右边的d(arr(i, 1))起到了计数的作用呀。

学习啊，我估计没法再快了[em04]

[em27][em27]

zsd5237

学习[em02][em02]

zjxia889

uRwmu9mr.rar (197.47 KB, 下载次数: 1)

2009-10-3 09:45 上传

点击文件名下载附件
[已解决]不重复数统计(怎样提速)

0.5秒不到

Sub 不重复数统计zjxia889()
    Dim i As Integer
    Dim t As Single
    Dim ARR
    Dim arr0(999, 1) As Integer
   
   
    t = Timer
    Application.ScreenUpdating = False
    Columns("C:D").Clear
    ARR = Range("A1:A" & Range("A65536").End(xlUp).Row)

    '求A列不重复数
    For i = 1 To UBound(ARR)
'        arr0(ARR(i, 1), 0) = ARR(i, 1)
        arr0(ARR(i, 1), 1) = arr0(ARR(i, 1), 1) + 1
    Next i
    For i = 0 To UBound(arr0)
        arr0(i, 0) = i
    Next i

    [d1].Resize(UBound(arr0) + 1, 2) = arr0
       
   
    Application.ScreenUpdating = True
    MsgBox Timer - t & "秒"
End Sub

zjxia889

Sub 不重复数统计排序()
    Dim i As Integer, k%
    Dim t As Single
    Dim ARR
    Dim arr0(1000, 1)

   
    t = Timer
    Application.ScreenUpdating = False
    Columns(1).Sort Cells(1, 1)
    Columns("C:D").Clear

    ARR = Range("A1:A" & Range("A65536").End(xlUp).Row)

    k = 0
    '求A列不重复数
    arr0(k, 0) = ARR(1, 1)
    arr0(k, 1) = 1
    For i = 2 To UBound(ARR)
        If ARR(i, 1) = ARR(i - 1, 1) Then
            arr0(k, 1) = arr0(k, 1) + 1
            Else
            k = k + 1
            arr0(k, 0) = ARR(i, 1)
            arr0(k, 1) = 1
        End If
    Next i

    [d1].Resize(UBound(arr0) + 1, 2) = arr0
       
   
    Application.ScreenUpdating = True
    MsgBox Timer - t & "秒"
End Sub

爱疯

谢谢zjxia889！！

原来数组也可累加噢，学习了！

oobird

因为你要判断的是数值而非文本值，所以直接以逻辑值判断会比用字典判断占优势。

1. Sub yy()<br/>&nbsp;&nbsp;&nbsp; Dim rng, i&amp;, j&amp;, t!, ARR<br/>&nbsp;&nbsp;&nbsp; Dim b(1000) As Boolean, c(1000) As Integer<br/>&nbsp;&nbsp;&nbsp; t = Timer<br/>&nbsp;&nbsp;&nbsp; rng = Range([a1], [a65536].End(3))<br/>&nbsp;&nbsp;&nbsp; ReDim ARR(1 To UBound(rng), 1 To 2)<br/>&nbsp;&nbsp;&nbsp; For i = 1 To UBound(rng)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If b(rng(i, 1)) = False Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; j = j + 1<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; c(rng(i, 1)) = j<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; b(rng(i, 1)) = True<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ARR(j, 1) = rng(i, 1)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ARR(j, 2) = 1<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Else<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ARR(c(rng(i, 1)), 2) = ARR(c(rng(i, 1)), 2) + 1<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp; Next<br/>&nbsp;&nbsp;&nbsp; [e1].Resize(j, 2) = ARR<br/>&nbsp;&nbsp;&nbsp; MsgBox Timer - t<br/>End Sub<br/>

复制代码

爱疯

谢谢O版！

看晕了，没明白

[em04]