内容提要

多个文件多个工作表数据汇总字典、数组综合运用

大家好，我是冷水泡茶。

今天在论坛上看到一个求助贴：

[求助] 紧急求助求助 多个员工简历表合并生成一个汇总表

现在有200多个员工的简历信息单表（图1），一人一个文件汇总到一个信息汇总表（图2）。

他的数据表是这样的：

图片

汇总表如下，每人一条记录，也就是把明细表给它改为标准的二维表：

图片

关于文件汇总合并，我们分享过案例【文件合并工具】、【Excel表合并】，合并对象都是标准的二维表，不适用今天这个案例。

今天这个问题看上去不是很复杂，如果所有人都是相同格式，我的意思是“父亲”、“母亲”都是全的，那就可以直接引用工作表单元格的位置来取得数据。

但我是不太喜欢直接引用单元格地址这种方式的，写死了，灵活性就差点，我们写代码还是应该尽量考虑变化、扩展、容错、特殊情况如何处理等等。

基本思路：

1、指定明细表文件夹，这里我们默认是跟“汇总表”放在同一个文件夹下。

2、循环文件夹中每一个文件，如果是Excel文件，我们就打开它，把它赋值给工作簿对象wb。

3、我们再循环wb中的每个工作表ws，虽说他这个明细表中只有一个工作表，但很多情况下并非如此，可能有其他表，工作表的名称也可能各不相同，所以我们要循环判断哪个工作表是我们需要汇总的目标工作表。

4、根据明细表格的结构特征，我们设置两个Range对象，rng1=A4:F5，rng2=A6:F8。

5、我们循环rng1，找到“姓名”单元格，再用offset函数取其右侧单元格，员工姓名，我们把它作为字典的key，用一个数组arr作为item。

6、我们再分别循环rng1与rng2，取得各个字段的值，填入arr，再把arr装回字典。

7、把字典的item写入目标工作表“汇总”。

图片

VBA代码

代码见第二条推文。

后记

1、代码写得比较冗长，我看到有人只写了20几行，主要采用直接指定目标数据单元格地址的方式。正如我前面所说，我不太喜欢这种方式，从某种程度上来说，降低灵活性，所以代码很长，也算情有可原吧。2、另外，我们还考虑了一些特殊情况，比如，父亲、母亲只有一条记录的，或者顺序颠倒的，都不影响取数的准确性。3、昨天的案例【提取最高学历】，有朋友留言，说代码可以简化一下，我研究了一下他的代码，思路的确不错，在此基础上，我重新梳理了一下思路，又精减了几行代码，与我昨天写的代码相比，减少了一大半：

Sub 最高学历()    Dim ws As Worksheet, lastRow As Integer    Dim arr(), arrEduBg(), dic As Object, dkey As String, dic1 As Object    Set ws = ThisWorkbook.Sheets("信息表")    Set dic1 = CreateObject("Scripting.Dictionary")    Set dic = CreateObject("Scripting.Dictionary")    With ws        lastRow = .UsedRange.Rows.Count        arr = .Cells(2, 1).Resize(lastRow - 1, 3).Value    End With    arrEduBg = Array("高中", "专科", "本科", "硕士", "博士")    For i = 0 To UBound(arrEduBg)        dic1(arrEduBg(i)) = i    Next    For i = 1 To UBound(arr)        If arr(i, 1) <> "" Then            dkey = arr(i, 1)            If Not dic.Exists(dkey) Then                dic(dkey) = Array(arr(i, 1), arr(i, 2), arr(i, 3))            Else                If dic1(arr(i, 3)) > dic1(dic(dkey)(2)) Then                    dic(dkey) = Array(arr(i, 1), arr(i, 2), arr(i, 3))                End If            End If        End If    Next    Sheets("学历表").Cells(2, 1).Resize(dic.Count, 3) = Application.Transpose(Application.Transpose(dic.items))End Sub

好，今天就到这，我们下期再会。 本站仅提供存储服务，所有内容均由用户发布，如发现有害或侵权内容，请点击举报。