字典应用-拆分工作簿

拆分工作簿

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-

  • 发表于:
  • 原文链接:http://kuaibao.qq.com/s/20180131G15R6600?refer=cp_1026

扫码关注云+社区