|
|
Option Explicit
Option Base 1 '所有数组都从1开始
Type final_list '自定义数据结构，myname将存放每个人的名字，而mynumbers()数组将存放每个人的机号列表
myname As String
mynumbers() As Long
End Type
Sub 汇总机号()
Dim name_dic, name_no_dic, name, name_no, name_machine() As final_list, machine_no
Dim data_in, data_out, last_row, max_numbers As Long
Dim i As Long, j As Long, new_record As Long, record_no As Long, arr_size As Long
Set name_dic = CreateObject("Scripting.Dictionary") '声明一个字典对象，用于快速查询人名
Set name_no_dic = CreateObject("Scripting.Dictionary") '声明一个字典对象，用于快速查询 "人名+机号"
Workbooks("机号与型号.xls").Sheets("列出每人在本月所使用的机号").Select '先清除旧的计算结果
Range("A2:Z65535").Clear
'读入所有的数据到VBA数组，这样所有计算都可以在VBA内部进行，不需要访问工作表，速度加快100倍以上
Workbooks("机号与型号.xls").Sheets("人名-机数-齿数").Select
last_row = [a65535].End(xlUp).Row
data_in = Range("A2:P" & last_row).Value '现在,data_in数组有 A2:P最后一行 的所有单元格数据
'逐行处理这些数据
new_record = 0 '从0开始，准备汇总所有人的机号记录
For i = LBound(data_in) To UBound(data_in) '遍历data_in数组，也就等于遍历对应工作表的所有单元格数据
name = data_in(i, 1) '每行记录的第一列是人名
machine_no = data_in(i, 2) '第二列是机号
name_no = name & "!" & machine_no '重复的机号只记录一次，所以我们需要第二个字典，根据人名+机号去查询
If Not name_dic.Exists(name) Then '假如人名是新的
new_record = new_record + 1 '那么记录累计＋1
name_dic.Add name, new_record '把新的人名，以及对应的新的记录号写入字典。
ReDim Preserve name_machine(1 To new_record) '记录人名-机号汇总结果的数组, 其大小也增加1
ReDim name_machine(new_record).mynumbers(1 To 1) '把该数组元素(final_list自定义数据类型), 其存放机号列表的数组，大小设置为1
name_machine(new_record).myname = name '该数组元素的人名，记录为当前行的人名
name_machine(new_record).mynumbers(1) = machine_no '此人的机号，记录为当前机号
name_no_dic.Add name_no, new_record '同样地，把"人名+机号"也新增到 人名_机号字典。
Else
If Not name_no_dic.Exists(name_no) Then '旧的人名肯定有机号记录,所以现在只需检查人名_机号字典，看看当前机号是否已经存在
record_no = name_dic.Item(name) '新的机号，则先找回此人名对应的final_list记录位置
arr_size = UBound(name_machine(record_no).mynumbers) '得到此记录的机号存放数组的大小
ReDim Preserve name_machine(record_no).mynumbers(arr_size + 1) '把记录机号的数组大小＋1
name_machine(record_no).mynumbers(arr_size + 1) = machine_no '把新的机号存入数组末尾
name_no_dic.Add name_no, new_record '当然，字典也需要增加一项纪录，说明机号已经被保存
If arr_size + 1 > max_numbers Then max_numbers = arr_size + 1 '这一句纯粹为了方便输出结果到工作表，有没有都可以
End If
End If
Next i
'到这里为止，我们已经把所有的人名－机号都存放在 name_machine数组
'此数组每条记录都是 final_list 自定义类型，即一个人名，对应一串机号
ReDim data_out(1 To UBound(name_machine), 1 To max_numbers + 1) '现在，我们需要另一个数组，把汇总后的结果输出到指定位置
For i = LBound(name_machine) To UBound(name_machine) '把final_list的数据，逐一按格式复制到data_out数组
For j = 1 To UBound(name_machine(i).mynumbers)
data_out(i, 1) = name_machine(i).myname
data_out(i, j + 1) = name_machine(i).mynumbers(j)
Next j
Next i
'现在，我们把最终输出的数据，按格式放在了data_out数组，直接输出到工作表即可
Workbooks("机号与型号.xls").Sheets("列出每人在本月所使用的机号").Select
Range("A2").Resize(i - 1, max_numbers) = data_out
End Sub
'大功告成，我们在上面所有的代码，只读写工作表两次，第一次是读入所有数据，第二次是输出所有数据的汇总结果
'而且查询人名，机号是否属于新增记录，我们使用两个字典去查询，速度快如闪电。 |
|
楼主: ljy688
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2010-12-7 21:14
发表于 2010-12-7 21:51
不带这样的