- 帖子
- 1478
- 主題
- 40
- 精華
- 0
- 積分
- 1502
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2025-10-23
|
6#
發表於 2023-3-21 13:53
| 只看該作者
本帖最後由 Andy2483 於 2023-3-21 14:03 編輯
回復 3# shuo1125
謝謝前輩發表此主題與範例
後學藉此主題練習陣列與字典的解決方案如下,請前輩參考
Option Explicit
Sub TEST()
Application.DisplayAlerts = False
Dim Brr, A, Y, Z, Yk, T$, T2$, T3$, T9$, T10$, S1$, S2$
Dim x%, C%, N&, i&, P&, B(3), Crr(1 To 1000, 1 To 20)
Set Y = CreateObject("Scripting.Dictionary")
Z = Array(, 4, 8, 10, 12, 14, 16, 15, 17)
Brr = Sheets("資料區").UsedRange
For i = 2 To UBound(Brr)
T2 = Brr(i, 2): T3 = Brr(i, 3)
S1 = T2 & "|" & T3: Y(S1 & "/b") = T2: Y(S1 & "/c") = T3
A = Y(S1)
If Not IsArray(A) Then A = Crr
T9 = Brr(i, 9)
B(1) = Mid(T9, 1, 3): B(2) = Mid(T9, 4, 2): B(3) = Mid(T9, 6, 2)
B(0) = B(1) & "." & B(2) & "." & B(3) & "#" & Val(Mid(T9, 8))
T10 = Brr(i, 10)
If T10 Like "沖*" = False Then
N = Y(S1 & "|r")
N = N + 1
Y(S1 & "|r") = N
S2 = B(0) & "-" & T10: Y(S2) = N
For x = 1 To 4: A(N, x) = Brr(i, Z(x)): Next
For x = 5 To 6
A(N, x) = Brr(i, Z(x)) + Brr(i, Z(x + 2))
A(N, x + 14) = A(N, x)
Next
Y(S1) = A
GoTo i01
ElseIf T10 Like "*月帳款" Then
B(0) = Mid(Split(T10, "月")(0), 2)
B(0) = B(0) & Replace(T10, "沖", ".#0-")
B(0) = Replace(B(0), "月帳款", "應付帳款總額")
ElseIf T10 Like "沖###/*#/*#*" Then
B(1) = Mid(T10, 2, 4)
B(2) = Format(Split(Mid(T10, 6), "#")(0), "MM/DD")
B(3) = "#" & Split(T10, "#")(1)
B(0) = Replace(B(1) & B(2) & B(3), "/", ".")
ElseIf T10 Like "沖?????* ###/*#/*#" Then
B(0) = Split(Mid(T10, 3), " ")
B(1) = Mid(Brr(i, 11), 1, 3)
B(2) = "." & Mid(Brr(i, 11), 4) & ".#0-"
B(3) = B(0)(0) & " " & B(0)(1)
B(0) = B(1) & B(2) & B(3)
End If
C = Format(Brr(i, 4), "M") + 6
A(Y(B(0)), C) = Brr(i, 16) + Brr(i, 17)
A(Y(B(0)), 20) = A(Y(B(0)), 20) - A(Y(B(0)), C)
P = Brr(i, 14) + Brr(i, 15)
A(Y(B(0)), 19) = A(Y(B(0)), 19) - P
Y(S1) = A
i01:
Next
'====================================
For Each Yk In Y.keys
If IsArray(Y(Yk)) Then
On Error Resume Next
Sheets(Val(Yk) & "").Delete
On Error GoTo 0
Sheets("科目餘額表").Copy Before:=Sheets(1)
With Sheets(1)
.Name = Val(Yk)
.UsedRange.Offset(5, 0).Delete
With .[A5].Resize(Y(Yk & "|r"), 20)
.Value = Y(Yk)
Intersect([E:T], .Cells).NumberFormatLocal = _
"_-* #,##0_-;-* #,##0_-;_-* ""-""??_-;_-@_-"
End With
.[C3] = Y(Yk & "/c")
.[C3] = .[C3] & "《" & Y(Yk & "/b") & "》"
N = .Cells(Rows.Count, "F").End(3).Row
With .Cells(N + 1, "F").Resize(1, 15)
.Value = "=SUM(F5:F" & N & ")"
End With
End With
End If
Next
Set Y = Nothing: Erase Brr, Crr, Z, A, B
End Sub |
|
發表於 2023-3-19 14:27
| 
