|
Sub 拆分为工作表()
Application.ScreenUpdating = False '防止屏幕抖动,屏幕刷新禁止
Application.DisplayAlerts = False
Dim sh As Worksheet
For Each sh In Worksheets
If sh.Name <> "初始表格" Then sh.Delete
Next
Sheets("初始表格").Range("A3:I" & Sheets("初始表格").Range("c65536").End(xlUp).Row).Sort Key1:=Range("C2"), Order1:=xlAscending
n = 3
With ThisWorkbook.Sheets("初始表格")
For Each b In .Range("c3:c" & .Range("c65536").End(xlUp).Row)
u = b.Row
If b <> b.Offset(1, 0) Then
Sheets.Add after:=Sheets(Sheets.Count)
.Rows("1:2").Copy Sheets(Sheets.Count).Range("a1")
.Rows(n & ":" & u).Copy Sheets(Sheets.Count).Range("a3")
Sheets(Sheets.Count).Name = Format(b, "m月-d日")
n = u + 1
End If
Next
End With
For Each sh In Sheets
If sh.Name <> "初始表格" Then
With sh
k = .Range("a65536").End(xlUp).Row
arr = .UsedRange
For i = 3 To UBound(arr)
For j = 4 To UBound(arr, 2)
If IsNumeric(.Cells(i, j)) Then
.Cells(k + 1, 1) = "合计"
.Cells(k + 1, j) = Application.Sum(Application.Index(arr, , j))
End If
Next
Next
End With
End If
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub |
评分
-
1
查看全部评分
-
|