excel中将一张表中数据拆分成多个工作表,按部门不相同的拆分成单个工作表,且单个工作表名及为部门
来源:互联网 发布:逛1小时淘宝用多少流量 编辑:程序博客网 时间:2024/05/16 08:55
在工作表名称上点右键选查看代码,粘贴以下代码到弹出窗口.关闭弹出窗口 ALT+F8选中该宏执行
Sub 拆分工作表()
Application.ScreenUpdating = False
Dim rng As Range, arr()
endrow = Range("A65536").End(xlUp).Row
ReDim arr(2, 0)
arr(0, 0) = Range("A2").Value
arr(1, 0) = Range("A2").Row
arr(2, 0) = Range("A2").Row
L = 0
For i = 2 To endrow
temp = Range("A" & i).Value
For ii = i + 1 To endrow
With Range("A" & ii)
If .Value = temp Then
arr(2, L) = .Row
Else
L = L + 1
ReDim Preserve arr(2, L)
arr(0, L) = .Value
arr(1, L) = .Row
arr(2, L) = .Row
i = .Row - 1
Exit For
End If
End With
Next
Next
For i = 0 To L
Workbooks.Add
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & arr(0, i)
ActiveSheet.Name = arr(0, i)
ActiveSheet.Range("A:C").ColumnWidth = 10
ActiveSheet.Range("A:C").HorizontalAlignment = xlCenter
ActiveSheet.Range("A:C").VerticalAlignment = xlCenter
ActiveSheet.Range("C:C").NumberFormatLocal = "m-d"
ActiveSheet.Range("D:D").ColumnWidth = 30
ThisWorkbook.Activate
Workbooks(arr(0, i) & ".xls").Sheets(1).Rows(1).Value = Sheet1.Rows(1).Value
For bc = arr(1, i) To arr(2, i)
Workbooks(arr(0, i) & ".xls").Sheets(1).Rows(bc - arr(1, i) + 2).Value = Sheet1.Rows(bc).Value
Next
Workbooks(arr(0, i) & ".xls").Close SaveChanges:=True
Next
Application.ScreenUpdating = True
MsgBox "拆分工作表完成!" & vbCrLf & "在当前工作薄路径下创建工作薄:" & L + 1 & "个."
End Sub
Sub 拆分工作表()
Application.ScreenUpdating = False
Dim rng As Range, arr()
endrow = Range("A65536").End(xlUp).Row
ReDim arr(2, 0)
arr(0, 0) = Range("A2").Value
arr(1, 0) = Range("A2").Row
arr(2, 0) = Range("A2").Row
L = 0
For i = 2 To endrow
temp = Range("A" & i).Value
For ii = i + 1 To endrow
With Range("A" & ii)
If .Value = temp Then
arr(2, L) = .Row
Else
L = L + 1
ReDim Preserve arr(2, L)
arr(0, L) = .Value
arr(1, L) = .Row
arr(2, L) = .Row
i = .Row - 1
Exit For
End If
End With
Next
Next
For i = 0 To L
Workbooks.Add
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & arr(0, i)
ActiveSheet.Name = arr(0, i)
ActiveSheet.Range("A:C").ColumnWidth = 10
ActiveSheet.Range("A:C").HorizontalAlignment = xlCenter
ActiveSheet.Range("A:C").VerticalAlignment = xlCenter
ActiveSheet.Range("C:C").NumberFormatLocal = "m-d"
ActiveSheet.Range("D:D").ColumnWidth = 30
ThisWorkbook.Activate
Workbooks(arr(0, i) & ".xls").Sheets(1).Rows(1).Value = Sheet1.Rows(1).Value
For bc = arr(1, i) To arr(2, i)
Workbooks(arr(0, i) & ".xls").Sheets(1).Rows(bc - arr(1, i) + 2).Value = Sheet1.Rows(bc).Value
Next
Workbooks(arr(0, i) & ".xls").Close SaveChanges:=True
Next
Application.ScreenUpdating = True
MsgBox "拆分工作表完成!" & vbCrLf & "在当前工作薄路径下创建工作薄:" & L + 1 & "个."
End Sub
0 0
- excel中将一张表中数据拆分成多个工作表,按部门不相同的拆分成单个工作表,且单个工作表名及为部门
- Excel中如何将一个Excel工作表的数据按一列的关键字拆分成多个工作表
- excel将一个工作表根据条件拆分成多个工作簿、工作表
- excel将一个工作表根据条件拆分成多个工作表图文教程
- C#将一个excel工作表根据指定范围拆分为多个excel文件
- 将excel的多个工作表拆分成独立的文件
- 列出与'SCOTT'从事相同工作的所有员工及部门名称、部门人数、平均工资
- 怎么拆分一个Excel工作簿中的多个工作表
- 怎么拆分一个Excel工作簿中的多个工作表?
- VBA代码实例---一个工作表拆分为N个工作表
- 数据部门-工作角色安排
- goldengate 单个表通过函数对replicate进程拆分(进程拆分系列之二)
- 部门表数据
- VBA异常--运行时错误1004(将一个工作簿拆分多个工作表)
- 【转载】在IT部门和研发部门的工作差别
- 在IT部门和研发部门的工作差别
- 在IT部门和研发部门的工作差别
- 在IT部门和研发部门的工作差别
- 四种常见的 POST 提交数据方式
- 跟踪框修正
- Session丢失罪魁祸首之BIN目录
- msi 中断的写tlp包在哪里产生?
- 【LeetCode】18_4Sum
- excel中将一张表中数据拆分成多个工作表,按部门不相同的拆分成单个工作表,且单个工作表名及为部门
- Eclipse 打开报错Java was Started but Returned Exit Code=13
- BZOJ1037
- 杭电 HDU 1219 java AC Me
- MT7620_看门狗(Watchdog)驱动
- 全局变量的另一种思路
- Git管理修正(取消跟踪、合并commit)
- hdoj 1896 Stones
- excel将一个工作表根据条件拆分成多个工作表图文教程