---- 100万行 ! ----- 多列独立汇总 ---- 自定义汇总方式 ---- 3秒完成一列

灰袍法师

根据大家的回帖，对原来版本的程序做了大幅改动。

新的附件是一个相当于 数据透视表 的程序。(当然，操作会麻烦很多，但是数据全部在单元格，后续处理比较灵活)

用户可以直接把数据粘贴进去，然后选择汇总方式，注意是每一列都可以选择单独的汇总方式

要处理多于四列的数据汇总，也只需要把现有的四列向右复制一下即可。

汇总需要至少两列

第一列C列，是要汇总的关键字，粘贴到 进行汇总的关键字 下面

第二列D列，关键字对应的需要汇总的数值，粘贴到绿色单元格开头的那一列，点击绿色单元格，选择计数，求和等等汇总方式的一个

第三列E列，点击计算按钮，就会产生汇总后的结果。

F,H,J等等绿色单元格开头的列，都可以粘贴其它汇总数值，对应的关键字还是C列，F,H,J列可以单独选择其它汇总方式

汇总结果需要人手去掉重复值，这在Excel2007版本就是很简单地选择数据菜单－－删除重复值就可以了。

以附件的测试数据为例
存在汇总数据
C列
厦门5980        30694         2        92183        8671391530        36074.0006        57122.17689        20        1130
厦门5980        82729         2        13179        8671391530        57122.17689        57122.17689        1130        1130

关键字 就是厦门5980
D列的计数汇总就是求所有厦门5980的对应数据，即是 30694和82729，汇总结果为2
E列就是汇总结果2，结果是每一条 厦门5980 的数据行汇总结果的单元格都会得到2这个结果

F列是求平方和汇总,92183和13179
G列就是 92183^2 + 13179^2

H列是求最大值，对应数值是36074.0006和57122.17689
I列就是最大值 57122.17689

J列是求最后出现的数值 20 和 1130
K列就是 1130了


有经验的VBA用户可以很轻松开发出自己的 自定义汇总方式，增加一个汇总项目和一个子过程即可。

跟数据透视表相比

数据透视表： 由于是Excel自带功能，用起来肯定更安全方便，而且很容易找到支持，由于是编译好的代码，而且可以用多核CPU，速度也更快。

这个附件：你可以学习一点新的数据处理方法，而且几乎可以自定义无限多种汇总方式，数据透视表没有的，你自己加上去就好了。

建议： 尽可能使用数据透视表，极度无聊的时候用这个玩玩吧。

附件的设计思路和算法：

1. VBA字典处理数十万个关键字的速度欠佳，所以附件使用了十个字典,每个最多存储10万关键字，并且放进(1 to 10)的数组方便存取

2. 附件利用这十个VBA字典，把关键字全部翻译为long类型的序列号，直接存入等于序列号的数组下标，这样在查询的时候就可以直接访问数组，而不再需要访问慢速的VBA字典

3. 通过模块化的编程方法，很轻松就可以增加自定义汇总方式，想怎么汇总都可以了。

[ 本帖最后由 灰袍法师 于 2010-10-21 15:38 编辑 ]

老伙计2008

坐沙发，顶一下。谢谢楼主分享

老伙计2008

100万行在我这里29.67秒完成
要好好学习一下

老伙计2008

计算D列到F列的汇总项目
100万行数据大概60秒完成

没有显示用时多少

zhaogang1960

没有理解楼主代码的实际意义
建议：既然使用数组就不要使用公式了，这60秒大多数用在了写公式上了，下面代码对公式理解的可能不对，请参考：
Sub 按钮2_Click()
Dim OutData(), TestRows As Long, i As Long
Dim OutArea As String, t0

t0 = Timer
ActiveSheet.UsedRange.Offset(99, 0).ClearContents
TestRows = [i1].Value
If TestRows <= 0 Then TestRows = 10000
If TestRows > Row_Limit Then TestRows = Row_Limit
[i1].Value = TestRows

OutArea = "B100:C" & TestRows

ReDim OutData(1 To TestRows - 99, 1 To 2)
OutData(1, 1) = Int((2000 * Rnd) + 1)
OutData(1, 2) = [C99]
If Rnd > 0.33 Then OutData(1, 2) = OutData(1, 2) + 1
For i = 2 To TestRows - 99
    OutData(i, 1) = Int((2000 * Rnd) + 1)
    If Rnd > 0.33 Then OutData(i, 2) = OutData(i - 1, 2) + 1 Else OutData(i, 2) = OutData(i - 1, 2)
Next i

Range(OutArea).Formula = OutData

[i2].Value = Timer - t0
End Sub

灰袍法师

原帖由 zhaogang1960 于 2010-1-16 03:57 发表
没有理解楼主代码的实际意义
建议：既然使用数组就不要使用公式了，这60秒大多数用在了写公式上了，下面代码对公式理解的可能不对，请参考：
Sub 按钮2_Click()
Dim OutData(), TestRows As Long, i As Long
Dim ...

公式是为了生成随机的测试数据，不然上传100万行的附件太夸张

目的就是生成一系列的ID，要求每个ID有1到n条记录（不然不叫汇总了）

确实如你所言，直接在VBA做可以节约很多时间。

本来我一开始是用单元格公式生成测试数据，后来觉得复制粘贴还是有点麻烦，就直接把公式复制到VBA代码，又懒得改了。

masterexcel

很不错，标记一个。

李子然

看看是什么？60秒的时间有点长了吧

jiliyacui

学习！十分关注！！

li130

台夸张了吧，如果用ACCESS处理会不会快点呢