楼主
い卋玑┾宝珼 |
在公司里，经常会有些表格，共享工作簿之后，可能同时有多个人一起填写。
对于这样的表格，如果大家同时填写在一行的话，保存时，就需要选择是保存对方的数据还是自己的数据，这造成了许多不遍。
于是提出了这样的一个需求。根据填写的表格的内容，依据需要填写的人员，拆分成多个表格，最终再将多个表格合并在一起。
合并后的表格，可以按照需要，进行排序等。
这件事情，用VBA是可以实现的。
第一步：准备一张表，具有三个sheet，表名类似如下：
第一页为最终统计的表，第二页放置模板，在第三页放置填写人的姓名等。
模板类似下图：
第三页的姓名列，类似下图
第二步：拆分表
根据第三页填写的信息，将表按人名拆分成多份- Sub AddForPerson()
- 'add workbook
- '
- Dim sh As Worksheet, i As Integer, sLocation As String
- ' 对于date中的所有的名字
- For i = 2 To ThisWorkbook.Sheets(3).Cells(Rows.Count, 1).End(3).Row
- '复制模板sheet
- ThisWorkbook.Sheets(2).Copy
- Set sh = ActiveSheet
- '改名
- sh.Name = ThisWorkbook.Sheets(3).Cells(i, 1).Value
- '设置保存路径
- sLocation = ThisWorkbook.Path & "\" & sh.Name & ".xls"
- ActiveWorkbook.SaveAs Filename:=sLocation, FileFormat:=xlNormal
- '关闭文档
- ActiveWorkbook.Close True
- Next
- End Sub
第三步，填写之后，合并表
需要注意的一点，以我公司的表为例，除了标题以后，还会增加一行或者两行例子，如图所示
所以在合并表的时候，需要从有效数据开始复制。- '合并总表
- Sub Summary()
- Dim wb As Workbook, sLocation$, sShName$, iRows As Integer, icolumn As Integer, iTotalCount As Integer, sh1 As Worksheet, iRowExample As Integer
- Set sh1 = ThisWorkbook.Sheets(1)
- iRowExample = ThisWorkbook.Sheets(2).Cells(Rows.Count, 2).End(3).Row '统计加例子一共多少行
- iRows = sh1.Cells(Rows.Count, 2).End(3).Row '总表中数据行数
- icolumn = sh1.Cells(1, Columns.Count).End(1).Column '总表中数据列数
- sh1.Range(sh1.Cells(iRowExample + 1, 1), sh1.Cells(iRows + 1, icolumn)).ClearContents '清空已经填写的数据
- For i = 2 To ThisWorkbook.Sheets(3).Cells(Rows.Count, 1).End(3).Row '姓名列表第一行为标题，所以从第二行取到最后一行
- sShName = ThisWorkbook.Sheets(3).Cells(i, 1).Value '取单元格内容
- '设置取文档的路径
- sLocation = ThisWorkbook.Path & "\" & sShName & ".xls"
- Workbooks.Open sLocation '打开文档
- iRows = ActiveWorkbook.Sheets(1).Cells(Rows.Count, 2).End(3).Row '填写数据的最后行
- icolumn = sh1.Cells(1, Columns.Count).End(1).Column '填写数据的最后列
- iTotalCount = sh1.Cells(Rows.Count, 2).End(3).Row '总表中已经转移了多少行
- If iRows > iRowExample Then '当个人表格中，有填写数据时
- ActiveWorkbook.Sheets(1).Range(ActiveWorkbook.Sheets(1).Cells(iRowExample + 1, 1), ActiveWorkbook.Sheets(1).Cells(iRows, icolumn)).Copy sh1.Cells(iTotalCount + 1, 1) '拷贝数据到总表
- End If
- ActiveWorkbook.Close True '关闭文档
- Next
- iTotalCount = sh1.Cells(Rows.Count, 2).End(3).Row '获取总表中数据总共行数
- If iTotalCount > iRowExample Then '当总表有填写数据时
- sh1.Cells(iRowExample + 1, "A") = 1 '设置起始编号
- sh1.Range("A" & iRowExample + 1).AutoFill Destination:=sh1.Range("A" & iRowExample + 1 & ":A" & iTotalCount), Type:=xlFillSeries '填充序号
- End If
- End Sub
在例如以上代码的时候，只需要将模板列和总表列的内容，换成你需要的数据即可
代码很简单，但是如果碰到共享的文档的时候，还是很实用的
表格合并之后，就可以在总表中，按照你需要的顺序，排列数据即可
PS。以上代码，在XP的2003和2007中，以及Win7的2003,2010与2013中测试均没有问题。如发现问题，请注明系统环境与使用版本，最好顺便带附件说明发生问题的环境。谢谢
2012-08-20日 12:35 修正：当没有填写任何数据的时候，统计的表格内容有问题，添加了保护处理
2012-08-20日 18:44修正：修正了起始序列号有时候不对的问题，添加代码sh1.Cells(iRowExample + 1, "A") = 1 '设置起始编号
 轻巧应对多人填写表时数据冲突问题，按姓名拆分表格，填写完毕并合并表格内容.rar
|
