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

shuo1125

各位前輩好!
想以字典法製作科目餘額明細，但條件涉及複雜真的弄不出來...
需求如下:
工作表為Sheet01資料區，Sheet02科目餘額表(套表)，其餘為轉出之各科目表。
一、資料區S欄為借貸餘，此部分用於餘額決定借-貸還是貸-借。
二、判斷條件為1.科目編號(B欄) 2.傳票編號-序(H欄) 3.幣別(L欄) 4.原幣金額(N : O欄) 5.本幣金額(P : Q欄) 6.沖銷的號碼註記(K欄) 7.借貸餘(S欄)。
三、判斷資料區B欄科目，同科目明細 依上述條件當月沖銷變化帶入科目餘額表(套表)中。
科目餘額表(套表)1-12月為本幣數不需處理原幣之變化，但原幣餘額需表達在S欄。
詳如附件，請問各位高手這有辦法處理嗎...
以上，再麻煩了，謝謝！！

准提部林

只拉出"立帳"的行???
有跨年, 模擬結果與資料月份也對不上!!!

shuo1125

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

singo1232001

回復 3# shuo1125


這有2個問題 待釐清

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

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

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

shuo1125

回復 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月。)

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

Andy2483

回復 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

回復 6# Andy2483
Andy2483大好!
我發現其實是上傳的模擬結果及資訊區皆有錯誤，怪不得當時準大會說有問題...
你針對錯的資訊還能做出對應的結果..
附上正確之版本..浪費了大家的時間...在此說聲抱歉!!
預計產出的結果為至截止日止立帳-沖帳後明細的餘額，沖帳時K欄註記的編號基本上會一對一沖銷。
(範例科目為2個，實際上會有多個..所以才想說以套表來產出各科目。)

Andy2483

回復 7# shuo1125


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

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

Andy2483

回復 7# shuo1125


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

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

下載 (104.82 KB)

2023-3-22 08:26

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

Andy2483

回復 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