[發問] 以字典方式製作餘額明細表

shuo1125

帖子: 121
主題: 8
精華: 0
積分: 170
點名: 62
作業系統: win10
軟體版本: Office2016
閱讀權限: 20
性別: 男
註冊時間: 2021-1-21
最後登錄: 2024-8-20

3^#

發表於 2023-3-19 16:27 | 只看該作者

本帖最後由 shuo1125 於 2023-3-19 16:40 編輯

回復 2# 准提部林
準大好!
確實是只需要列出立帳的明細....模擬資料有點誤差我更正一版並附上需要"結果說明"。
以科目表達至截止日沖銷完成之明細(例:借餘，模擬結果為扣掉貸方沖銷後剩餘之明細，但沖銷後為0者還是要顯示。)
暫時只需要記錄當年變化就好，因年初我會更新餘額，所以是以年初各科目餘額+本年明細帳變化去做。
詳如附檔，抱歉表達不清..可在勞煩準大協助嗎?

TEXT20230318-1.zip (34.71 KB)

singo1232001

　暱稱: 熱狗慶

帖子: 354
主題: 5
精華: 0
積分: 387
點名: 0
作業系統: windows7
軟體版本: vba,vb,excel2007
閱讀權限: 20
性別: 男
註冊時間: 2017-1-8
最後登錄: 2024-8-2

論壇榮譽勳章論壇贊助勳章

4^#

發表於 2023-3-20 12:57 | 只看該作者

本帖最後由 singo1232001 於 2023-3-20 13:03 編輯

回復 3# shuo1125

這有2個問題待釐清

A:
立帳與沖帳目前看來有點問題
1.無關鍵資料欄位能夠判斷兩筆是否同一筆
2.只能模糊的用金額判斷是否相同, 也有可能發生金額不同的沖帳
3.反之若只依照同科目編號與金額相同來判斷是否同一筆那就可能會有錯誤

B:
沖帳時的月份
若10901 ,11001,11101 跨年度都要算在一月嗎?

檔案並未製作完成只是練習用而已

TEXT20230318-1 v1.zip (49.43 KB)

shuo1125

帖子: 121
主題: 8
精華: 0
積分: 170
點名: 62
作業系統: win10
軟體版本: Office2016
閱讀權限: 20
性別: 男
註冊時間: 2021-1-21
最後登錄: 2024-8-20

5^#

發表於 2023-3-20 14:22 | 只看該作者

本帖最後由 shuo1125 於 2023-3-20 14:29 編輯

回復 4# singo1232001
慶大好!

A:
立帳與沖帳目前看來有點問題
1.無關鍵資料欄位能夠判斷兩筆是否同一筆
  >關鍵在資料區的K欄的"備註"，其實是我將期初數更新後，與當期明細帳合併在同一工作表表達。
(以圖AB為例，111/03/11立了一筆11103110001-10金額$235,104，112/01/18發生沖帳備註沖銷編號在資料區K欄此筆沖銷金額$235,104，
立帳時為11103110001-10這筆，沖帳是發生在112/01月所以不用記錄該傳票編號-序，只將沖銷金額表達在立帳的1-12月月沖銷數中。)

2.只能模糊的用金額判斷是否相同, 也有可能發生金額不同的沖帳
  >比對條件基本上是以立帳的傳票編號-序來看，基本上與資料區K欄(圖A)沖銷的備註一定會相等(一筆對沖一筆)，皆不考慮比對金額只要表達沖銷月發生之沖銷額就好。

3.反之若只依照同科目編號與金額相同來判斷是否同一筆  那就可能會有錯誤
  >K欄註記的編號正常都是單筆沖銷，若傳票編號-序為5碼等同，不考慮金額只表達立帳沖銷月發生之沖銷金額。
B:
沖帳時的月份
  >只要沖銷年月在當月，就都是變化再1月，立帳明細有跨年為正常，因是月初剩下的餘額明細。(以圖A來看，11201發生沖銷，所以變化就都在表達在1月。)

以上，表達一直不清造成困擾在此深感抱歉....再請協助!!

圖A.PNG (76.42 KB)

圖B.PNG (91.8 KB)

　暱稱: 厚臉皮的學生

帖子: 1447
主題: 40
精華: 0
積分: 1471
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-12-5

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

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

shuo1125

帖子: 121
主題: 8
精華: 0
積分: 170
點名: 62
作業系統: win10
軟體版本: Office2016
閱讀權限: 20
性別: 男
註冊時間: 2021-1-21
最後登錄: 2024-8-20

7^#

發表於 2023-3-21 21:20 | 只看該作者

本帖最後由 shuo1125 於 2023-3-21 21:21 編輯

回復 6# Andy2483
Andy2483大好!
我發現其實是上傳的模擬結果及資訊區皆有錯誤，怪不得當時準大會說有問題...
你針對錯的資訊還能做出對應的結果..
附上正確之版本..浪費了大家的時間...在此說聲抱歉!!

預計產出的結果為至截止日止立帳-沖帳後明細的餘額，沖帳時K欄註記的編號基本上會一對一沖銷。
(範例科目為2個，實際上會有多個..所以才想說以套表來產出各科目。)

TEXT20230318-2.zip (34.39 KB)

　暱稱: 厚臉皮的學生

帖子: 1447
主題: 40
精華: 0
積分: 1471
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-12-5

8^#

發表於 2023-3-22 07:23 | 只看該作者

回復 7# shuo1125

謝謝前輩回復
1.正所謂當局者迷,解範例才知範例問題在哪裡
2.前輩多慮了,並沒有浪費時間,後學在論壇上在此帖上學習到很多知識

3.就後學的認知與經驗,備註欄屬於雜項欄位,做為關鍵字欄有很多疑慮,
請前輩查證一下K欄備註欄是否都只放傳票編號-序(沖銷號碼)

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

　暱稱: 厚臉皮的學生

帖子: 1447
主題: 40
精華: 0
積分: 1471
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-12-5

9^#

發表於 2023-3-22 08:01 | 只看該作者

本帖最後由 Andy2483 於 2023-3-22 08:26 編輯

回復 7# shuo1125

以K欄備註欄都只放傳票編號-序(沖銷號碼)的情境下做字典對照解決方案如下,
請前輩參考

K欄備註欄(傳票編號-序)沖銷H欄(傳票編號-序),一對多對沖銷是什麼規則??

Option Explicit
Sub TEST()
Application.DisplayAlerts = False
Dim Brr, A, Y, Z, Yk, T2$, T3$, T8$, T11$, S1$
Dim x%, C%, N&, i&, P&, 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
T8 = Brr(i, 8): T11 = Brr(i, 11)
If T11 Like "#####*" = False Then
   N = Y(S1 & "|r")
   N = N + 1
   Y(S1 & "|r") = N
   Y(T8) = 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
End If
C = Format(Brr(i, 4), "M") + 6
A(Y(T11), C) = Brr(i, 16) + Brr(i, 17)
A(Y(T11), 20) = A(Y(T11), 20) - A(Y(T11), C)
P = Brr(i, 14) + Brr(i, 15)
A(Y(T11), 19) = A(Y(T11), 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
End Sub

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

　暱稱: 厚臉皮的學生

帖子: 1447
主題: 40
精華: 0
積分: 1471
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-12-5

10^#

發表於 2023-3-22 08:35 | 只看該作者

本帖最後由 Andy2483 於 2023-3-22 09:05 編輯

回復 7# shuo1125

1.是以(幣別 + 傳票編號-序)美金沖銷美金,台幣沖銷台幣嗎?

2.結果表的S欄原幣餘額總合計有意義嗎? 保留合計或取消合計?
PS:原幣餘額可能有多種幣別的餘額,相加被引用堪慮

Option Explicit
Sub TEST_幣別_傳票編號序()
Application.DisplayAlerts = False
Dim Brr, A, Y, Z, Yk, T2$, T3$, T8$, T11$, T12$, S1$, S2$
Dim x%, C%, N&, i&, P&, 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
T8 = Brr(i, 8): T11 = Brr(i, 11): T12 = Brr(i, 12)
If T11 Like "#####*" = False Then
   N = Y(S1 & "|r"): N = N + 1: Y(S1 & "|r") = N
   S2 = T8 & "|" & T12: 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
End If
C = Format(Brr(i, 4), "M") + 6
S2 = T11 & "|" & T12
A(Y(S2), C) = Brr(i, 16) + Brr(i, 17)
A(Y(S2), 20) = A(Y(S2), 20) - A(Y(S2), C)
P = Brr(i, 14) + Brr(i, 15)
A(Y(S2), 19) = A(Y(S2), 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 & ")"
         If .Item(14) <> .Item(15) Then .Item(14) = "NA"
      End With
   End With
End If
Next
Set Y = Nothing: Erase Brr, Crr, Z, A
End Sub

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流