Option Explicit
Sub TEST()
Dim Brr, Crr, V, A, i&, j%, R&, C%, x%, S$, T
T = Timer
Sheets(1).Activate
Brr = Range(Cells(2, Columns.Count).End(xlToLeft), Cells(Rows.Count, 1).End(3))
ReDim Crr(1 To UBound(Brr), 1 To 6)
Workbooks.Add
For j = UBound(Brr, 2) To 4 Step -1
For i = 1 To UBound(Brr)
If i = 1 Then A = Crr: R = 1: S = Brr(1, j): GoTo j1
V = Val(Brr(i, j))
If V = 0 Then: GoTo j1: Else R = R + 1
For x = 1 To 3: A(R, x) = Brr(i, x): Next
A(R, 6) = A(R - 1, 6) + V
C = IIf(V > 0, 4, 5)
A(R, C) = IIf(C = 4, V, -V)
j1: Next
If R = 1 Then: GoTo j0
Sheets.Add.Name = S
[A1].Resize(R, 6) = A
[A1].Resize(1, 3) = Brr
[D1:E1] = "AMOUNT (" & Mid(S, InStr(S, "(") + 1): [F1] = "BALANCE"
[A:F].Columns.AutoFit
[C:C].ColumnWidth = 60
[C:C].WrapText = True
j0: Next
MsgBox "共耗時：" & Timer - T & " 秒"
End Sub作者: mdr0465 時間: 2025-8-16 20:31
