【原】字典应用-拆分工作簿（汇总逆过程）

拆分工作簿

Split   Workbook

从这节课开始，给大家讲解几节课的字典的知识。这节课我们先用实例感受一下字典强大的功能。下节课开始讲解字典知识点。

前两天给大家分享的汇总工作簿的实例，在实际应用中用处很大。但是他的逆过程，拆分工作簿为若干个工作簿。用处也是非常大的。这节课就给大家分享拆分工作簿的一般操作。

如下图所示，为上次汇总以后的工作簿（这里人为调换行的位置，体现数据的无规律），我们要按照A列的不同文件名字，拆分道各自的工作簿。拆分后为：每日登记A组.xls、每日登记B组.xls、每日登记C组.xls......等等

那么用代码我们怎么操作呢？

➜编 程 思 路：将A列字符串利用字典，去重复写入字典关键字。将B列-O列写入字典条目。然后新建以字典关键字为名称的工作簿，对应的字典条目写入新的工作簿。

➜实 现 代 码：

Sub 拆分()

    Application.ScreenUpdating = False '关闭屏幕闪动，提速

    Application.DisplayAlerts = False '关闭窗口提示

    kk = 2

    Set dic = CreateObject("scripting.dictionary")'后期绑定

    With ThisWorkbook.Worksheets("汇总表")

        Set rng1 = .Range("a1:o1")

        If [a2] = "" Then Exit Sub

            rrow = .Cells(Rows.Count, "a").End(xlUp).Row

            arr = WorksheetFunction.Transpose(.Range("a1:a" & rrow))

            For i = 2 To UBound(arr)  '将A列已有数据写入字典，为了去重复。也可以用高级筛选

                If Not dic.exists(arr(i)) Then '若字典中不存在该字符串，则写入。

                    dic.Add arr(i), .Range("a" & i).Resize(1, 15)

                Else

                    Set dic.Item(arr(i)) = Union(dic.Item(arr(i)), .Range("a" & i).Resize(1, 15))'union方法合并字典条目

                End If

            Next

            k = dic.keys

            l = dic.items

        For ss = 0 To dic.Count - 1

            Set wb = Workbooks.Add '新建工作簿

            With wb.Worksheets(1)

                rng1.Copy .Range("a1") '把表头的前一行也一同复制到新工作表中

                l(ss).Copy .Range("a2") '把字典的条目，也就是筛选出来的数据复制到新表

            End With

            wb.SaveAs ThisWorkbook.Path & "\" & Replace(k(ss), ".xls", "") & ".xlsx" '将新建的工作簿保存在代码工作簿下

            wb.Close True '关闭工作簿，并保存

            Set wb = Nothing '释放内存

        Next

    End With

    Application.ScreenUpdating = True

    Application.DisplayAlerts = True

    MsgBox "完成"

End Sub

➜实现效果：

是不是感受到字典的神奇了？这些工作如果手动做，复制粘贴，不知道需要多久才能做完，但是VBA的字典几秒钟搞定。

当然，除了字典，这个问题也可以用其他方法解决，但是代码要比字典多，运行速度也没有字典方法快。

只写干货，期待你的关注。