ExcelHome技术论坛

标题: [原创]任意的拆分、合并工作薄和工作表(已升级了分类汇总功能) [打印本页]
作者: 彭希仁    时间: 2006-10-23 21:37
标题: [原创]任意的拆分、合并工作薄和工作表(已升级了分类汇总功能)

[attach]374757[/attach]
[此贴子已经被作者于2008-6-18 9:03:52编辑过]
[ 本帖最后由 彭希仁 于 2008-12-2 10:35 编辑 ]
作者: 徒然客    时间: 2006-10-24 09:35
不错的源代码，改一改就可以用了。谢谢你的分享！
作者: lingdo2001    时间: 2006-10-24 10:25

HOW TO USE ,GIVE ME A EXAMPLE,OK?

I'M SO GREEN BIRD[em04]

作者: 彭希仁    时间: 2006-10-24 11:06
QUOTE:
以下是引用lingdo2001在2006-10-24 10:25:24的发言：

HOW TO USE ,GIVE ME A EXAMPLE,OK?

I'M SO GREEN BIRD[em04]

已经加入了实例，不过这个程序通用性很强基本上没有受到格式的限制，支持从其它工作薄调用。

[此贴子已经被作者于2006-10-24 11:08:04编辑过]
作者: yehf    时间: 2006-10-24 14:43
强
作者: 风飞    时间: 2006-10-24 18:04

谢了

作者: jcgl    时间: 2006-10-25 13:17
“将同路径下的多张工作薄中的工作表合并到当前活动的工作表”想在复制每个工作表前加一行应如何修改？谢
作者: 彭希仁    时间: 2006-10-26 10:08

Sub 将同路径下的多张工作薄中的工作表合并到当前活动的工作表()
    Application.ScreenUpdating = False
    Dim lj, dirname, nm
    Dim a As Long
    Dim i As Long
    lj = ThisWorkbook.Path
    nm = ThisWorkbook.Name
    dirname = Dir(lj & "\*.xls")
    Do While dirname <> ""
        If dirname <> nm Then
            Workbooks.Open Filename:=lj & "\" & dirname
            a = Sheets.Count  '读当前工作薄中的所有的工作表
            Workbooks(nm).Activate
            For i = 1 To a
                Workbooks(dirname).Sheets(i).UsedRange.Copy Range("a65536").End(xlUp).Offset(2, 0)    '复制新打开的工作簿的第一个工作表的已用区域到rng
            Next i
            Workbooks(dirname).Close False
        End If
        dirname = Dir
    Loop
   
End Sub

这样就可以“将同路径下的多张工作薄中的工作表合并到当前活动的工作表”想在复制每个工作表前加一行应如何修改

作者: wu_ybnet    时间: 2006-10-30 09:52

好贴，学习

作者: haodayikeshu    时间: 2006-10-31 14:49
早就想找这么个东东，今天终于找到啦。谢谢
作者: butterflyqqq    时间: 2006-10-31 22:05
好东东，顶~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
作者: txj138    时间: 2006-11-3 10:03

怎么使用的啊,我打开了,什么也没有啊

作者: 彭希仁    时间: 2006-11-3 14:44

工具　　宏　VBA编辑器　　你就可以看到源代码了　　至于使用可以打开其它的EXCEL文档，直接调用本工具就可以实现以上功能了。

作者: yehf    时间: 2006-11-3 15:33
如果能加一个功能,把工作表拆分成工作簿或者工作表时,先填一个文本,然后新的名称就根据类别加文本那就更好了.
作者: haoxin    时间: 2006-11-6 10:04
学习中
作者: 完美主义者    时间: 2006-11-8 23:01

好贴，学习

作者: newspace    时间: 2006-11-17 10:25

急需使用这个功能，麻烦请教一下如何使用，谢谢！

请不吝赐教，我的邮箱是：roadfund@126.com

作者: tuckey1123    时间: 2006-11-21 15:52
超级好，帮了我的大忙了。谢谢LZ。
作者: linbin_1978    时间: 2006-12-9 15:36
  非常实用，谢谢分享！
作者: ladhome    时间: 2006-12-14 13:01
一个不错的工具，谢谢分享，下载学习。
作者: shujiandi    时间: 2006-12-20 10:47
好，非常好使，谢谢
作者: lytlxh    时间: 2006-12-23 14:39

好用啊!!!!

作者: dxy27    时间: 2007-1-12 09:46

太谢谢仁兄了！

另外请问，如果用“将同路径下的多张工作薄中的工作表合并到当前活动的工作表”这个宏时想从

某一行开始应该怎么修改呢？（我要合并的表前10行都是表头，第11开始是数据），哪位知道麻烦告诉我，谢谢！

Sub 将同路径下的多张工作薄中的工作表合并到当前活动的工作表()
    Application.ScreenUpdating = False
    Dim lj, dirname, nm
    Dim a As Long
    Dim i As Long
    lj = ActiveWorkbook.Path
    nm = ActiveWorkbook.Name
    dirname = Dir(lj & "\*.xls")
    Do While dirname <> ""
        If dirname <> nm Then
            Workbooks.Open Filename:=lj & "\" & dirname
            a = Sheets.Count  '读当前工作薄中的所有的工作表
            Workbooks(nm).Activate
            For i = 1 To a
                Workbooks(dirname).Sheets(i).UsedRange.Copy Range("a65536").End(xlUp).Offset(1, 0)    '复制新打开的工作簿的第一个工作表的已用区域到rng
            Next i
            Workbooks(dirname).Close False
        End If
        dirname = Dir
    Loop
   
End Sub

作者: 彭希仁    时间: 2007-1-12 11:14

分两步走可以搞定


6.将同路径下的多张工作薄中的工作表合并为当前活动工作薄的很多张工作表
1.将一个工作薄的若干工作表任意的合并成一张工作表（可以选择表头行的）

作者: boraid    时间: 2007-1-28 16:25

再次表示感谢～～～～

作者: jlumath    时间: 2007-1-29 14:56

怎么使用呀？

我要将当前活动的工作表拆分成多个工作表，例如将1-465行拆为一个工作表，467-821行为第二个工作表，同样，822-1568，1569-2015，2016-2970...可是一点击宏中的执行，却弹出第一列序号，添加？

怎么回事？

Sub 将当前活动的工作表拆分成多个工作表()
 UserForm4.Show (0)
End Sub

这里的USERFORM4什么意思？

偶是新手，希望得到大家的帮助！

[em17]
作者: 彭希仁    时间: 2007-1-29 15:36

[em06]

拆分是需要标识的，例如工作表有36000行，第二列是省份（第一行到1000行是北京，第1001行到2000是辽宁。。。。。。。共36个），这样你就可以按省份进行拆分。

作者: jlumath    时间: 2007-1-29 17:01

哦，看来我的数据还用不了

我的数据是1-30000条，每组一定数目的条数，将这个工作表拆分成多个工作表

作者: 彭希仁    时间: 2007-1-29 17:42

你可以加一辅助列来实现啊

作者: 煮青蛙    时间: 2007-1-29 19:40
支持！ 可没法下载。
作者: jlumath    时间: 2007-1-31 11:31
QUOTE:
以下是引用彭希仁在2007-1-29 17:42:15的发言：

你可以加一辅助列来实现啊

怎样进行？具体一点？是自然数列么？
作者: 彭希仁    时间: 2007-1-31 16:22

你不是有序号吗？

=INT(（A1-1）/ 465)    向下一拉

[此贴子已经被作者于2007-1-31 16:37:24编辑过]
作者: myfigure888    时间: 2007-4-16 16:17
谢谢你的分享！
作者: compaq    时间: 2007-4-22 21:28
谢谢楼主的无私。
作者: xuwenning    时间: 2007-4-25 10:07
xiexie
作者: 999hot    时间: 2007-4-28 23:25
多谢楼主,兄弟正为这事着急呢!
作者: pingquanren    时间: 2007-5-2 09:24
“另类汇总”为什么仅仅能汇总14列，怎样增加到50列，因为我表的列数太多。有那位高手给改一下，使之能汇总多列，我对vba什么也不懂呀，谢谢你老人家！！！在线等！
作者: yvw    时间: 2007-5-2 10:37
谢谢你的分享！
作者: pingquanren    时间: 2007-5-2 13:51
QUOTE:
以下是引用pingquanren在2007-5-2 9:24:08的发言：
“另类汇总”为什么仅仅能汇总14列，怎样增加到50列，因为我表的列数太多。有那位高手给改一下，使之能汇总多列，我对vba什么也不懂呀，谢谢你老人家！！！在线等！

有人回答吗？

作者: 43379677    时间: 2007-5-3 19:12

它是根据标题行来判断行，所以标题有50就能汇总50

作者: 丁壬易龙    时间: 2007-5-12 14:14
谢谢了，我会努力学习的[em02]
作者: dszh    时间: 2007-5-24 01:02
有价值，用得上，谢谢！
作者: narutoshyb    时间: 2007-5-24 14:33
谢谢你的分享！
作者: 丁壬易龙    时间: 2007-5-24 14:51

你们辛苦了

[em04]
作者: 丁壬易龙    时间: 2007-7-7 20:24

再次路过...

再次支持一下,此作品,对我来说,确实好用!

只稍作修改一上代码就可以为已工作了!

减少了很多查询工作!

[em02][em10]
作者: xiouzii    时间: 2007-7-22 20:29

[em02]好东东！

支持，同时也谢谢了！

作者: noweb    时间: 2007-8-2 17:57

对彭希仁老大表示最最衷心的感谢！！！您的作品大大提高了俺的工作效率！
如果您来成都，请与我联系，想请您吃饭！QQ:19685469

作者: sun729    时间: 2007-8-19 18:13
谢谢分享！
作者: mailhui    时间: 2007-8-23 23:08
谢了，省了我很多工作
作者: 不死之王    时间: 2007-8-25 01:04
我找了很久了,实在太感谢了.
作者: leo_zp_yang    时间: 2007-8-29 15:39
收藏了，有空好好研究！
作者: lgangg    时间: 2007-11-14 16:49

谢了,实用的很.

不过有点小bug,是字符型的数字,例如工作表中的某项值为 '005',拆分后的工作表中为"5",转成数字了

作者: jjwj    时间: 2007-12-25 08:05
好好学习，天天向上。
作者: z663624    时间: 2007-12-28 10:37
年终到了，需要合并报表，太需要这个软件了，多谢啦！帮了大忙了
作者: karlgh    时间: 2007-12-29 13:51
不错
作者: XQQYSK    时间: 2007-12-31 09:57
hi
作者: CUICUI5866    时间: 2007-12-31 10:08

好东西，学学啊。

作者: hylid    时间: 2008-1-22 12:48
非常棒的工具，多谢了！
作者: zhou68    时间: 2008-1-22 22:58
看看是怎么样
作者: chenwerr    时间: 2008-1-27 18:38

非常之好。可是我是菜鸟。不知道要怎么稍做修改。提示“找不到工程或库”谁告诉我怎么回事啊？

作者: zqxzhs    时间: 2008-2-16 00:21
不错，支持
作者: fyb0087    时间: 2008-2-25 08:21
请解决,合并计算有问题
作者: 彭希仁    时间: 2008-2-26 08:08

请解决,合并计算有问题

什么问题呢?

作者: grainboy    时间: 2008-2-27 15:52

彭兄

可以告诉，在什么情况下提示 不建议拆分 ？

是因为我的数据量太大了吗 ?

作者: fyb0087    时间: 2008-2-27 17:12

合并栏次多的表格，汇总时出现栏次汇总不全，老出错

作者: 彭希仁    时间: 2008-2-28 10:22

可以告诉，在什么情况下提示 不建议拆分 ？

如果拆分依据列,拆分后可以达到了几百个表就会提示"不建议拆分",可选择其它列为拆分依据

作者: cxx123456    时间: 2008-3-9 08:09

谢谢!

作者: zzddhyq    时间: 2008-3-31 10:40
好东东,先下,谢谢楼主
作者: wskwsk1    时间: 2008-4-2 12:28
太棒了,精品不断.....好东西...顶起[em02][em02][em02][em02]
作者: wskwsk1    时间: 2008-4-2 12:37

请问楼主.这个贴子的工具与http://club.excelhome.net/dispbbs.asp?boardid=2&replyid=1018825&id=268622&page=2&skin=0&Star=8有什么不要样呢

作者: wskwsk1    时间: 2008-4-2 12:53
不知楼主能不能再优化一下,在窗体加个最小化呢?那样更方便
作者: 靓鼠    时间: 2008-4-2 16:55
图片也不加个说明
作者: tianzhen1016    时间: 2008-4-3 14:32

谢谢，太好了哦

作者: editwork    时间: 2008-4-12 08:34

真是太棒了的工具。高手呀。谢谢

作者: 天骄宝贝    时间: 2008-4-12 21:57
是不是不能下载了啊?
作者: haiyangaofei    时间: 2008-4-14 10:08
标题: 提个建议，不知说的对不对？

版主，你的工具确实功能比较实用，对经常向各个单位分表及回收汇总的人来说是一大福音。在试用后，我觉得美中不足的几点是：1、原表的某些格式拆分后没能保存下来，比如像列的宽度拆分后就没能和原表一样。2、合并表之后，表的列宽和行高的格式都取消了。3、原表中如果有工作表保护密码的，拆分后能不能还保留原来的密码，这样做的好处是，拆分完成后向下属单位分发就不需要逐个地进行工作表的密码保护了。如果能改成这样的效果，我十分乐意向版主支付一定的费用，在我们单位进行推广。只是个人的一点看法，如有不当之处，请见谅。

[此贴子已经被作者于2008-4-14 10:56:07编辑过]
作者: 彭希仁    时间: 2008-4-15 09:05

版主，你的工具确实功能比较实用，对经常向各个单位分表及回收汇总的人来说是一大福音。在试用后，我觉得美中不足的几点是：

1、原表的某些格式拆分后没能保存下来，比如像列的宽度拆分后就没能和原表一样。

(这个问题不大,可以在拆分之前用格式刷刷一下)

2、合并表之后，表的列宽和行高的格式都取消了。

(可以办到,但会影响速度),

3、原表中如果有工作表保护密码的，拆分后能不能还保留原来的密码，这样做的好处是，拆分完成后向下属单位分发就不需要逐个地进行工作表的密码保护了。如果能改成这样的效果，我十分乐意向版主支付一定的费用，在我们单位进行推广。只是个人的一点看法，如有不当之处，请见谅。

(工作表保护,你是要如何一个保护法?,本人可以另外做一个专门加密程序,而不是在拆分的时候进行)

(, 下载次数: 513)     第一点和第二点已经修改好,你试用一下看吧.
[此贴子已经被作者于2008-4-15 9:40:09编辑过]
作者: 彭希仁    时间: 2008-4-15 09:49

这样吧,你录一个工作表保护密码的宏,发给我,我做一个专门的密码批量保护程序给你.

作者: haiyangaofei    时间: 2008-4-15 11:18

非常感谢版主的热心，我又试了一下，第一个问题确实已经好了。

第二个问题合并表之后还有问题，合并之后，要合并的第一个表的行高格式保留了下来，第二个以后的表格的行高格式还没能保留。

我对Excel仅仅是会用，“录一个工作表保护密码的宏”没能理解您的意思。

第三个问题我举个例子来说：总表当中有姓名、学校、学籍号三列内容，是全部学校的汇总数据，我将姓名、学校两列内容设为不可更改，学籍号一列设为可更改的（取消单位格保护）以便分发给各个学校进行修改，然后加一个密码对工作表的内容进行保护。我的工作是将这个总表按学校拆分成相应的工作簿分发给各个学校进行修改，并且只允许其修改其中的学籍号一列，如果拆分后的每个工作簿都能继承总表的工作表保护密码，我就不需要逐个打开各个学校的分表进行工作表的保护了，因为对50多个学校来说，这个工作太繁琐了。

作者: 彭希仁    时间: 2008-4-15 12:00
QUOTE:
以下是引用haiyangaofei在2008-4-15 11:18:29的发言：

非常感谢版主的热心，我又试了一下，第一个问题确实已经好了。

第二个问题合并表之后还有问题，合并之后，要合并的第一个表的行高格式保留了下来，第二个以后的表格的行高格式还没能保留。

行高要保留需要牺牲时间为代价.

我对Excel仅仅是会用，“录一个工作表保护密码的宏”没能理解您的意思。

第三个问题我举个例子来说：总表当中有姓名、学校、学籍号三列内容，是全部学校的汇总数据，我将姓名、学校两列内容设为不可更改，学籍号一列设为可更改的（取消单位格保护）以便分发给各个学校进行修改，然后加一个密码对工作表的内容进行保护。我的工作是将这个总表按学校拆分成相应的工作簿分发给各个学校进行修改，并且只允许其修改其中的学籍号一列，如果拆分后的每个工作簿都能继承总表的工作表保护密码，我就不需要逐个打开各个学校的分表进行工作表的保护了，因为对50多个学校来说，这个工作太繁琐了。

作者: 彭希仁    时间: 2008-4-16 09:02

你说的这事功能都可以办到.有空我帮你改改吧

作者: yunli    时间: 2008-5-4 10:21

看了！！！！！！！！

作者: japan_li    时间: 2008-5-15 22:50
老大实在太感谢您了，您的奉献精神，比解放军还解放军。谢谢了
作者: lyllc2002    时间: 2008-5-18 11:25
版主，能否在合并时加入我想合并的行号范围选项，如在版面上增加合并开始行、终止行，这样如果一个工作表有数千行，而我仅需合并其中2行，我可输入开始行为345行，终止行为346行，这样非常灵活。
作者: 彭希仁    时间: 2008-5-19 11:13
QUOTE:
以下是引用lyllc2002在2008-5-18 11:25:35的发言：
版主，能否在合并时加入我想合并的行号范围选项，如在版面上增加合并开始行、终止行，这样如果一个工作表有数千行，而我仅需合并其中2行，我可输入开始行为345行，终止行为346行，这样非常灵活。

可以办到,但这个工具,要满足所有的要求是做不到的.只能满足大部分人的要求.

作者: yunli    时间: 2008-5-23 16:01

已经加入了实例，不过这个程序通用性很强基本上没有受到格式的限制，支持从其它工作薄调用。

作者: konig    时间: 2008-6-26 15:03

不好意思，请问lz，为何我在excel2007中打开这个工具后，总是无法执行宏，总是中断呢？

作者: 紫色烟灰    时间: 2008-7-12 14:41
谢谢你的分享！
作者: xiaoyi0430    时间: 2008-7-15 08:07
不错的代码 ...
作者: lnjyzxp    时间: 2008-7-15 22:36
很好，我喜欢，强烈支持！
作者: 两点    时间: 2008-7-19 23:43

谢谢版主的无私分享！

精品啊！收藏。

作者: unibeau    时间: 2008-7-21 19:20
怎么用呀
作者: linux118    时间: 2008-7-23 22:02
不错的代码，赞一个
作者: huigezhuang    时间: 2008-7-24 16:15

版主，你真的好伟大，我之前下载过的，现在看到这个工具好亲切呀。真是谢谢你

作者: yitiantian    时间: 2008-8-2 22:05
刚好急用,雪中之炭啊!太感谢了!
作者: gaohong33    时间: 2008-8-5 14:39
不错，谢谢分享[em20]
作者: rabort    时间: 2008-8-5 16:27

多谢分享

作者: lvenqi    时间: 2008-8-7 07:41

收下了，太好了

作者: yun_1980    时间: 2008-8-12 16:54

测试了一下，合并时，如果引用的工作表和被引用的工作表都是保护状态的，会报错。

Sheets(j).Cells.Copy Workbooks(nm).Sheets(Sheets(j).Name).Cells(1, 1)

请问除了解除密码之外，可能修改代码？引用、被引用工作表的密码，合并前都是知道的。

感谢！

作者: qqhrboy    时间: 2008-8-16 18:26
好东西，真遇到了需要合并多个文档的大活，有了这样工具可是省力了，要不得累个好歹的，谢谢您将自己的杰作与我们分享



欢迎光临 ExcelHome技术论坛 (https://club.excelhome.net/) Powered by Discuz! X3.4