Andy2483

¦^´_ 1# mdr0465


    ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò
«á¾ÇÂǦ¹©«½m²ß°}¦C,½m²ß¤è®×¦p¤U,½Ð«e½ú°Ñ¦Ò

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 "¦@¯Ó®É¡G" & Timer - T & " ¬í"
End Sub