字典应用-拆分工作簿

拆分工作簿

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的字典几秒钟搞定。

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

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

-END-