6被浏览3733分享邀请回答14 条评论分享收藏感谢收起0添加评论分享收藏感谢收起写回答1 个回答被折叠（）查看: 4201|回复: 6
怎么使用宏来做到把总表的内容按照一定的要求分成多个分表
阅读权限10
在线时间 小时
我是经常要做重复的事情，就是处理总表，然后按照一定的规则要求把总表分成多个分表。我觉得重复的事情应该可以做成一个宏或者其他什么的来简化工作。
对于总表划分成分表的一些要求和例子我做了个样表。
一些要求和说明如下：
1、表加工中心是个范本；
2、总表生成分表时，以A列中的设备名称为分表的名称；
3、总表的第1列不在分表中体现。分表的第一列由总表中的“设备名称”列和“周”列组合而成；
4、总表的第2列“周”不在分表中体现出来。
5、分表中不同“周”的行之间隔2行空白行区分。
6、总表中的其他内容自动分解到各个分表中。
7、最后一列“上机日期”不在分表中体现。
8、表单的排序是：总表，清单表，后面是各个分表。
请老师们帮忙！
08:32 上传
点击文件名下载附件
48.67 KB, 下载次数: 132
阅读权限50
在线时间 小时
Sub test() 'by feiren228
& & Application.ScreenUpdating = False
& & Application.DisplayAlerts = False
& & Dim arr, brr(1 To
To 18), bt, i&, j&, n&, k1, k2, temp, sh As Worksheet
& & Set d = CreateObject(&scripting.dictionary&)
& & With Sheets(&总表&)
& && &&&r& = .Cells.Find(&*&, Cells(1, 1), xlValues, xlWhole, xlByRows, xlPrevious).Row '计算工作表最后一个非空行号
& && &&&arr = .Range(&a1:s& & r)
& && &&&bt = .[c1:s1]
& && &&&For i = 2 To UBound(arr)
& && && && &If Not d.exists(arr(i, 1)) Then Set d(arr(i, 1)) = CreateObject(&scripting.dictionary&)
& && && && &If Not d(arr(i, 1)).exists(arr(i, 2)) Then
& && && && && & d(arr(i, 1))(arr(i, 2)) = i
& && && && &Else
& && && && && & d(arr(i, 1))(arr(i, 2)) = d(arr(i, 1))(arr(i, 2)) & &,& & i
& && && && &End If
& && &&&Next
& && &&&For Each k1 In d
& && && && &For Each sh In Worksheets
& && && && && & If sh.Name = k1 Then Sheets(k1).Delete
& && && && &Next
& && && && &Sheets.Add after:=Sheets(Sheets.Count)
& && && && &ActiveSheet.Name = k1
& && && && &For Each k2 In d(k1)
& && && && && & temp = d(k1)(k2)
& && && && && & If InStr(temp, &,&) & 0 Then
& && && && && && &&&temp = Split(temp, &,&)
& && && && && && &&&For i = 0 To UBound(temp)
& && && && && && && && &n = n + 1
& && && && && && && && &brr(n, 1) = arr(temp(i), 1) & &-B(& & arr(temp(i), 2) & &)&
& && && && && && && && &For j = 2 To 18
& && && && && && && && && & brr(n, j) = arr(temp(i), j + 1)
& && && && && && && && &Next j
& && && && && && &&&Next i
& && && && && & Else
& && && && && && &&&n = n + 1
& && && && && && &&&brr(n, 1) = arr(temp, 1) & &-B(& & arr(temp, 2) & &)&
& && && && && && &&&For j = 2 To 18
& && && && && && && && &brr(n, j) = arr(temp, j + 1)
& && && && && && &&&Next j
& && && && && & End If
& && && && && & n = n + 2
& && && && &Next k2
& && && && &With Sheets(k1)
& && && && && & .Columns(&R:R&).NumberFormatLocal = &yyyy-m-d&
& && && && && & .[b1].Resize(1, UBound(bt, 2)) = bt
& && && && && & .[a2].Resize(n, 18) = brr
& && && && && & .UsedRange.Columns.AutoFit
& && && && &End With
& && && && &n = 0: Erase brr
& && &&&Next k1
& && &&&.Activate
& && &&&MsgBox &拆分完成！&
& & End With
& & Application.DisplayAlerts = True
& & Application.ScreenUpdating = True
End Sub
复制代码
阅读权限50
在线时间 小时
(92.04 KB, 下载次数: 213)
10:05 上传
点击文件名下载附件
阅读权限10
在线时间 小时
feiren228 发表于
非常感谢老师，非常给力！基本上解决了我的问题。真是大解放啊！
还有一点小问题。应该是我还没有描述清楚，请谅解。
1、还需要一个“清单表”（依据附件中的清单表的模式）
2、分表中的第一列需要由总表的“N”列和“周”列组合而成。因为我把总表的第一列标题写成了“设备名称1”可能让您有歧义了。
3、在分表中，第一列请按设备名称和周这两个选项排序展示。（按这个次序设备名称、周）
阅读权限10
在线时间 小时
能帮忙再抽时间看看吗？
非常感谢！
阅读权限50
在线时间 小时
能帮忙再抽时间看看吗？
非常感谢！
....
Sub test() 'by feiren228
& & Application.ScreenUpdating = False
& & Application.DisplayAlerts = False
& & Dim arr, brr(1 To
To 18), bt, i&, j&, n&, k1, k2, temp, sh As Worksheet
& & Set d = CreateObject(&scripting.dictionary&)
& & With Sheets(&总表&)
& && &&&r& = .Cells.Find(&*&, Cells(1, 1), xlValues, xlWhole, xlByRows, xlPrevious).Row '计算工作表最后一个非空行号
& && &&&.Range(&a2:t& & r).Sort key1:=.[n2], key2:=.[b2]
& && &&&arr = .Range(&a1:s& & r)
& && &&&bt = .[c1:s1]
& && &&&For i = 2 To UBound(arr)
& && && && &If Not d.exists(arr(i, 14)) Then Set d(arr(i, 14)) = CreateObject(&scripting.dictionary&)
& && && && &If Not d(arr(i, 14)).exists(arr(i, 2)) Then
& && && && && & d(arr(i, 14))(arr(i, 2)) = i
& && && && &Else
& && && && && & d(arr(i, 14))(arr(i, 2)) = d(arr(i, 14))(arr(i, 2)) & &,& & i
& && && && &End If
& && &&&Next
& && &&&For Each k1 In d
& && && && &For Each sh In Worksheets
& && && && && & If sh.Name = k1 Then Sheets(k1).Delete
& && && && &Next
& && && && &Sheets.Add after:=Sheets(Sheets.Count)
& && && && &ActiveSheet.Name = k1
& && && && &For Each k2 In d(k1)
& && && && && & temp = d(k1)(k2)
& && && && && & If InStr(temp, &,&) & 0 Then
& && && && && && &&&temp = Split(temp, &,&)
& && && && && && &&&For i = 0 To UBound(temp)
& && && && && && && && &n = n + 1
& && && && && && && && &brr(n, 1) = arr(temp(i), 14) & &-(& & arr(temp(i), 2) & &)&
& && && && && && && && &For j = 2 To 18
& && && && && && && && && & brr(n, j) = arr(temp(i), j + 1)
& && && && && && && && &Next j
& && && && && && &&&Next i
& && && && && & Else
& && && && && && &&&n = n + 1
& && && && && && &&&brr(n, 1) = arr(temp, 14) & &-(& & arr(temp, 2) & &)&
& && && && && && &&&For j = 2 To 18
& && && && && && && && &brr(n, j) = arr(temp, j + 1)
& && && && && && &&&Next j
& && && && && & End If
& && && && && & n = n + 2
& && && && &Next k2
& && && && &With Sheets(k1)
& && && && && & .Columns(&R:R&).NumberFormatLocal = &yyyy-m-d&
& && && && && & .[b1].Resize(1, UBound(bt, 2)) = bt
& && && && && & .[a2].Resize(n, 18) = brr
& && && && && & .UsedRange.Columns.AutoFit
& && && && &End With
& && && && &n = 0: Erase brr
& && &&&Next k1
& && &&&.Activate
& && &&&MsgBox &拆分完成！&
& & End With
& & Application.DisplayAlerts = True
& & Application.ScreenUpdating = True
End Sub
复制代码
阅读权限20
在线时间 小时
学习，点赞！！！
最新热点 /1
Excel三大神器，函数、数据透视表、VBA，分分钟学起来！
原价257元，领券后仅需126元，相当于4.9折！优惠券数量有限，先到先得。活动时间：即日起至12月14日。
玩命加载中，请稍候
玩命加载中，请稍候
Powered by
本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！ & & 本站特聘法律顾问：徐怀玉律师 李志群律师88被浏览9765分享邀请回答club.excelhome.net/thread--1.html兰色幻想vba从入门到进阶80集完整版.zip其他大概可能会涉及到的代码相关知识有：遍历的几种方法FSO之文件及文件夹操作方法instr函数的用法（用来判断单元格是否包含某些关键词，以进行无用数据的清洗）字典的用法：（大量数据的高效处理方法）正则表达的用法（处理某些特殊规律的数据）你们这些人，老是光收藏不点赞。。。咱以后不发这种打包整理型的干货了。。32325 条评论分享收藏感谢收起/p/24354951?utm_source=weibo&utm_medium=social（想看更多？下载 @知乎 App：）0添加评论分享收藏感谢收起如何将EXcel 表中每行的相关信息按照固定的格式批量生成新的EXcel 表,每行生成一张表。_百度知道
色情、暴力
我们会通过消息、邮箱等方式尽快将举报结果通知您。
如何将EXcel 表中每行的相关信息按照固定的格式批量生成新的EXcel 表,每行生成一张表。
原表包括很多户主的信息，是列表形式的。新表是一户一表。
拆分工作表为工作薄需要用宏来处理Excel 内 按 Alt+F11 视图--代码窗口，把如下复制进去 按F5运行即可请这个Excel 放到一个文件夹内操作, 默认生成到当前文件夹Sub&fencun()Application.ScreenUpdating&=&Falseb&=&Sheets.CountFor&i&=&1&To&bSheets(i).Copya&=&ThisWorkbook.Worksheets(i).NameWith&ActiveWorkbook.SaveAs&Filename:=ThisWorkbook.Path&&&&\&&&&a&&&&.xlsx&.CloseEnd&WithNext&iApplication.ScreenUpdating&=&trueEnd&Sub效果如下例：
采纳率：56%
来自团队：
首先选定一行2、点击工具栏中的数据-----筛选-----自动帅选3、点击选定的那行，依次选择您要依据此来帅选的相关信息4、再将生成的那张表复制到另外的表中就可以了5嘿嘿。1，这个我知道
嘿嘿，可我需要的第二表是不同格式的啊。第一表一行信息，第二表是一张表格。
我怎么听不明白你说的呢？你需要的第二表是什么格式，设置下就可以了啊你将每个新表复制到一个表上不就可以了吗看我这么热心回答 帮我选为最佳答案吧，俺就差这个了
本回答被网友采纳
！！！！！！！！！不知道！
为您推荐：
其他类似问题
excel的相关知识
换一换
回答问题，赢新手礼包