excel中将一张表中数据拆分成多个工作表，按部门不相同的拆分成单个工作表，且单个工作表名及为部门
发布网友
发布时间：2022-05-15 12:52
共3个回答
热心网友
时间：2023-10-24 04:57
方法和详细的操作步骤如下：
1、第一步，在excel加载项中，选择“方方格子”选项，然后选择“汇总拆分”选项，见下图，转到下面的步骤。
2、第二步，执行完上面的操作之后，在下拉菜单中，选择“拆分工作簿”选项，见下图，转到下面的步骤。
3、第三步，执行完上面的操作之后，设置要拆分的工作表以及需要存储的位置，然后单击“确定”，见下图，转到下面的步骤。
4、第四步，执行完上面的操作之后，将提示“立即查看文件”，见下图，转到下面的步骤。
5、第五步，执行完上面的操作之后，在指定的文件夹中，可以看到拆分的表格并完成拆分，见下图。这样，就解决了这个问题了。
热心网友
时间：2023-10-24 04:58
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
热心网友
时间：2023-10-24 04:58
