返回列表 上一主題 發帖

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

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

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

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

TEXT20230318.zip (17.83 KB)

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

TOP

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

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

TEXT20230318-1.zip (34.71 KB)

TOP

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

回復 3# shuo1125


這有2個問題 待釐清

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

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

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

TEXT20230318-1 v1.zip (49.43 KB)

TOP

本帖最後由 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
圖B.PNG

TOP

本帖最後由 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
看得懂是應該的,懂得應用才像學生,臉皮厚點學會更謹慎積極

TOP

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

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

TEXT20230318-2.zip (34.39 KB)

TOP

回復 7# shuo1125


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

3.就後學的認知與經驗,備註欄屬於雜項欄位,做為關鍵字欄有很多疑慮,
請前輩查證一下K欄備註欄是否都只放 傳票編號-序(沖銷號碼)
看得懂是應該的,懂得應用才像學生,臉皮厚點學會更謹慎積極

TOP

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

回復 7# shuo1125


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

K欄備註欄(傳票編號-序)沖銷H欄(傳票編號-序),一對多對沖銷是什麼規則??
20230322-1.jpg
前天 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
看得懂是應該的,懂得應用才像學生,臉皮厚點學會更謹慎積極

TOP

本帖最後由 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
看得懂是應該的,懂得應用才像學生,臉皮厚點學會更謹慎積極

TOP

        靜思自在 : 有願放在心裡,沒有身體力行,正如耕田不播種,皆是空過因緣。
返回列表 上一主題