[已解决]数组字典多条件汇总

上清宫主

代码长点，但时空还算过得去
Sub test()
t = Timer
Dim ar1(), ar2()
ar1 = Sheet1.[a2:g8061].Value '多取一个空行，便于操作
ar2 = Application.Transpose(Sheet2.[a1:e1]) '结果的表头,转一下是便于用redim
str1 = ar1(1, 2): r% = 1 '初始化一下
For i% = 1 To UBound(ar1)
    If str1 = ar1(i, 2) Then
       s = s + ar1(i, 1)
       n = n% + 1
       If ar1(i, 5) = "TOP10%" Then
          top10s = top10s + ar1(i, 1) '累加
          top10n = top10n% + 1  '计数
       End If
       If ar1(i, 6) = "TOP30%" Then
          top30s = top30s + ar1(i, 1) '累加
          top30n = top30n% + 1  '计数
       End If
       If ar1(i, 7) = "TOP50%" Then
          top50s = top50s + ar1(i, 1) '累加
          top50n = top50n% + 1  '计数
       End If
    Else
       r = r + 1
       If r > UBound(ar2, 2) Then ReDim Preserve ar2(1 To 5, 1 To r + 10)
       ar2(1, r) = str1  '写入分类
       str1 = ar1(i, 2)
       i = i - 1
       If n Then    '四个if算四类平均值
          ar2(5, r) = s / n
          s = 0
          n = 0
       End If
       If top10n Then
          ar2(2, r) = top10s / top10n
          top10s = 0
          top10n = 0
       End If
       If top30n Then
          ar2(3, r) = top30s / top30n
          top30s = 0
          top30n = 0
       End If
       If top50n Then
          ar2(4, r) = top50s / top50n
          top50s = 0
          top50n = 0
       End If
    End If
Next
Sheet3.[a1].Resize(r, 5) = Application.Transpose(ar2)
Sheet3.[g2] = Timer - t
End Sub

爱疯

7楼，省事，好理解吧
9楼，首先用一个数组输出
10楼，好像追求最少行数。（当然，这是出于好玩）
11楼，再学习
12楼，只是纠正了7楼的最大不足。

附件是前12#的答案： 如何汇总（前12楼）.rar (184.62 KB, 下载次数: 19)

2013-4-17 16:32 上传

点击文件名下载附件






通过比较，发现自己7楼 k=dic(t) 以后，快了一大半噢（以后要养成习惯，别多读对象）
开始没预想好，等到输出时，只能分成3次
又没本质改善，还是追不上上清。
再去学习。。。。。。。
{:031:}

飞云流水

爱疯 发表于 2013-4-17 15:50
7楼，省事，好理解吧
9楼，首先用一个数组输出
10楼，好像追求最少行数。（当然，这是出于好玩）

爱疯老师，数据超过10万，数据溢出，麻烦你修改一下，就9楼的老师没有溢出

飞云流水

上清宫主 发表于 2013-4-17 14:52
代码长点，但时空还算过得去
Sub test()
t = Timer

老师的代码很好，就是数据超过10万计算后溢出

爱疯

如何汇总（前15楼）.rar (194.46 KB, 下载次数: 88)

2013-4-17 18:23 上传

点击文件名下载附件

没法测。

上清宫主

要是再空间换时间：一次性把ar2的行数redim到足够大，就可省去多次redim和两回transpose，这样一来速度还会有大幅提高
溢出则可将For i% = 1 To UBound(ar1)中的%换成&大至就可以了

飞云流水

非常感谢爱疯老师不厌弃烦的解答问题，上清老师的代码真的很好，运行速度也很快10万数据只用了0.2秒，太强大了，同时感谢另外两位老师，我把正确答案给爱疯老师，感谢他汇集，让我学到了很多！谢谢！

yuanxin1314

学习了，，谢谢楼主和各位老师

tgydslr

学习学习

gipsy

学习下