完善工作表拆分

zhangguochang · 发表于 2014-2-24 22:10

本帖最后由 zhangguochang 于 2014-2-24 22:51 编辑

做了一个拆分工作表的宏，请各位大师帮忙修改完善一下；要求：1、各个分表的样式要和主表一致，包括字体、表格的格式等；2、各分表的项目5 项目6的求和本人不会做，请大师帮忙完善；本人不胜感激！！详见附件

ggsmart · 发表于 2014-2-24 22:27

《别怕，Excel VBA其实很简单》中就有这样的例子。你可以拿来看看。

zhangguochang · 发表于 2014-2-24 22:30

本人对vba不懂的恳请大师帮忙

ggsmart · 发表于 2014-2-24 22:33

合并和拆分都给你找来了，你看看。

4.7.7 批量对数据进行分类.rar (179.94 KB, 下载次数: 86)

4.7.9 快速合并多表数据.rar (177.74 KB, 下载次数: 53)

zhangguochang · 发表于 2014-2-24 22:41

这不是我想要的，请下载我的附件看看

zhaogang1960 · 发表于 2014-2-24 22:41

请参考：

Dim sh As Worksheet, arr, s$, i&, k, t, lc&
arr = [a1].CurrentRegion
lc = UBound(arr, 2)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With CreateObject("scripting.dictionary")
For i = 6 To UBound(arr) - 1
s = arr(i, 3)
If Not .Exists(s) Then .Add s, Cells(i, 1).Resize(1, lc) Else Set .Item(s) = Union(.Item(s), Cells(i, 1).Resize(1, lc))
Next i
k = .keys
t = .Items
End With
For Each sh In Sheets
If sh.Name <> "总表" Then sh.Delete
Next
Set sh = Sheets("总表")
For i = 0 To UBound(k)
sh.Copy After:=Sheets(Sheets.Count)
With ActiveSheet
For Each shp In .Shapes
shp.Delete
Next
.Name = k(i)
.UsedRange.Offset(5).Clear
t(i).Copy .Cells(6, 1)
End With
Next
sh.Activate
Application.ScreenUpdating = True
End Sub

复制代码

zhaogang1960 · 发表于 2014-2-24 22:45

采用字典+区域的方法拆分，为了保持工作表格式，采用复制Sheets("总表")为各分表
请测试附件

工作表拆分.rar (16.76 KB, 下载次数: 90)
如果不需要考虑格式，可以采用字典+数组的方法加快速度

zhangguochang · 发表于 2014-2-24 22:48

不行啊，请上传附件看看

jbjbzjb · 发表于 2014-2-24 22:50

冷眼旁观，猜测着大家伙写出来的代码必然形似而神不似，今果不其然。

评：
1.楼主仅是为了学习而已，并非实际工作需要，懒得为此写代码；
2.从附件看，显然是一会计数据资料，却遮遮掩掩，面目全非，从而造成他人写出形似而神不似的代码，悲哉；
3.狗屁格式不要变，拆分得到的表，其“余额”栏不得相应跟着减少嘛？!!!!
4.其它……，懒得再扯。

zhangguochang · 发表于 2014-2-24 22:53

你在下载我的附件看看

		自动登录	找回密码
密码			免费注册

[求助] 完善工作表拆分

评分

评分