shuo1125

回復 8# Andy2483
Andy大大好!

1.正所謂當局者迷,解範例才知範例問題在哪裡
  >感謝你的體諒...
2.前輩多慮了,並沒有浪費時間,後學在論壇上在此帖上學習到很多知識
  >您的求知精神確實值得效仿，這裡很多熱心的高手，但我程度低落，僅能看看試著理解寫法.....
3.就後學的認知與經驗,備註欄屬於雜項欄位,做為關鍵字欄有很多疑慮,
  >是....但因現行沒有特殊能註記的欄位，制式的系統又無法新增欄位，所以才會填在備註...但基本上一定是單筆對沖。
     若是5碼的(例:11101)，只管其沖銷後的金額。
請前輩查證一下K欄備註欄是否都只放 傳票編號-序(沖銷號碼)
  >沖銷時放的K欄必定為傳票編號-序。
以上，多謝你的耐心回復!!!

shuo1125

回復 9# Andy2483
Andy大好!
1.是以(幣別 + 傳票編號-序)美金沖銷美金,台幣沖銷台幣嗎?
  >外幣沖銷外幣，台幣沖銷台幣。
2.結果表的S欄原幣餘額 總合計有意義嗎? 保留合計或取消合計?
  >原幣數不需要加總，因為會有幣別不同的狀況(會需要此欄位是因為要知道原幣剩多少)
PS:原幣餘額可能有多種幣別的餘額,相加被引用堪慮
  >確實是...多幣別時沖銷會表達不同幣別沖銷。(例:立帳編號11112 USD1,246 NTD38,003 沖帳時資訊為K欄11112 USD1,246 NTD38,003)
     請看圖C，需對應幣別沖銷。

(請看圖D，以1821來看，資料區最後餘額7,407,492會等於科目餘額的7,407,492)
以上，我是以期初數+本年明細做，所以沖銷時就列在各月裡就好，對同幣別進行沖銷(最後科餘餘額會等同於資料區各科目最後的餘額。)

敘述不清請再請理解...感謝各位相助!!

Andy2483

回復 12# shuo1125


    T欄 沖帳 對應K欄(備註)是空格,而不是 號碼(傳票編號-序)代表什麼意思?

下載 (218.4 KB)

2023-3-22 10:28

請前輩查證一下K欄備註欄是否都只放 傳票編號-序(沖銷號碼)
  >沖銷時放的K欄必定為傳票編號-序。

shuo1125

回復 13# Andy2483
Andy大好!
該筆是立帳，後面的T欄錯了.....，所以K欄不會有沖銷編號。
(1821來看，該筆期初是借餘為立帳，貸餘時沖帳；2143期初貸餘則反之，貸餘為立帳，借餘為沖帳。)

以上，你真的很細心...謝謝你不吝其煩的回覆!!

Andy2483

回復 14# shuo1125


    因為K欄做對應可能不牢靠,需要更多驗證檢查
以下這問題也是手誤?還是系統撈資料就錯?
立帳 K欄有號碼
還是其他因素?

下載 (215.33 KB)

2023-3-22 10:48

shuo1125

回復 15# Andy2483
Andy大好!
立沖帳T欄為公式帶入，因是我作範例時填錯第16.17列T欄反了....非原始系統產製資料。
立帳時備註可能會有其他編號，基本條件為科目代號、備註、幣別、借貸餘去判斷.....
(只有沖帳時K欄才有意義，紀錄對應的傳票編號-序)
以上，謝謝你!!

Andy2483

回復 16# shuo1125


    謝謝前輩,請試試看

Option Explicit
Sub TEST()
Application.DisplayAlerts = False
Dim Brr, A, Y, Z, Yk, T2$, T3$, T8$, T11$, T12$, T20$, 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): T20 = Brr(i, 20)
   If T20 = "沖帳" Then
      If T11 Like "#####*" = False Then
         Application.Goto Sheets("資料區").Rows(i)
         MsgBox "沖帳備註欄異常": Exit Sub
      End If
      If Y.Exists(T11 & "|" & T12) = Empty Then
         Application.Goto Sheets("資料區").Rows(i)
         MsgBox "無法沖帳": Exit Sub
      End If
   End If
   If T20 = "立帳" 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"
            '↑結果表總餘額合計 如果S欄<>T欄!就讓S欄顯示 "NA"
            '否則S欄同T欄
         End With
      End With
   End If
Next
Set Y = Nothing: Erase Brr, Crr, Z, A
End Sub

shuo1125

回復 17# Andy2483
Andy大好!
針對我問題感謝你的大力協助....
你的程序範例檔已可使用，但我用在實際上要使用的明細中會出錯...
這部分應該就是我資料檔自己的問題...我在想辦法自行修正...
在此感謝你勞心了，謝謝您!

Andy2483

回復 18# shuo1125


    謝謝前輩再回復
後學藉此主題學習到很多知識,學習心得註解如下,請前輩參考,請各位前輩指教
如果還有後學可以學習的!請前輩繼續提出

Option Explicit
Sub TEST()
Application.DisplayAlerts = False
'↑令程序遇到是否真的要刪除的疑問時,就不要再問了!刪了他!
Dim Brr, A, Y, Z, Yk, T2$, T3$, T8$, T11$, T12$, T20$, S1$, S2$
Dim x%, C%, N&, i&, P&, Crr(1 To 1000, 1 To 20)
'↑宣告變數:(Brr,A,Y,Z,Yk)是通用型變數,
'(T2,T3,T8,T11,T20,T12,S1,S2)是字串變數,(x,C)是短整數變數,
'(N,i,P)是長整數變數,Crr是陣列變數(縱向1到1000,橫向1到20)
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y這通用型變數是 字典
Z = Array(, 4, 8, 10, 12, 14, 16, 15, 17)
'↑令Z這通用型變數是一維陣列(共9個陣列值,索引號0到8)
Brr = Sheets("資料區").UsedRange
'↑令Brr這通用型變數是二維陣列,以資料區表有使用儲存格值帶入
For i = 2 To UBound(Brr)
'↑設順迴圈!i從2到Brr陣列縱向最大索引列號
   T2 = Brr(i, 2): T3 = Brr(i, 3)
   '↑令T2這字串變數是 i迴圈列第2欄Brr陣列值,
   '令T3這字串變數是 i迴圈列第3欄Brr陣列值
   S1 = T2 & "|" & T3: Y(S1 & "/b") = T2: Y(S1 & "/c") = T3
   '↑令S1這字串變數是 T2變數 連接"|" 再連接T3變數的新字串,
   '令以S1變數 連接"/b"成的新字串當key,item是T2變數,納入Y字典
   '令以S1變數 連接"/c"成的新字串當key,item是T3變數,納入Y字典
   A = Y(S1)
   '↑令A這通用型變數是 以S1變數查Y字典得到的item值
   If Not IsArray(A) Then A = Crr
  '↑如果A變數經判斷:不是陣列!就令A變數是Crr變數
   T8 = Brr(i, 8): T11 = Brr(i, 11)
   T12 = Brr(i, 12): T20 = Brr(i, 20)
   '↑令T8這字串變數是 i迴圈列第8欄Brr陣列值,
   '令T11這字串變數是 i迴圈列第11欄Brr陣列值,
   '令T12這字串變數是 i迴圈列第12欄Brr陣列值
   '令T20這字串變數是 i迴圈列第20欄Brr陣列值
   If InStr("/沖帳/立帳/", "/" & T20 & "/") = 0 Then
   '↑如果T20變數不是 沖帳 ,也不是 立帳??
      Application.GoTo Sheets("資料區").Rows(i)
      '↑令儲存格游標跳到i變數列
      MsgBox "T欄不明 立沖帳類別": Exit Sub
      '↑跳出提示窗~~~:結束程式執行
   End If
   If T20 = "沖帳" Then
   '↑如果T20變數是 "沖帳"字串 ?
      If T11 Like "#####*" = False Then
      '↑如果T11變數不是以5個連續數字開頭的字串?
         Application.GoTo Sheets("資料區").Rows(i)
         '↑令儲存格游標跳到i變數列
         MsgBox "沖帳備註欄異常": Exit Sub
         '↑跳出提示窗~~~:結束程式執行
      End If
      If Y.Exists(T11 & "|" & T12) = Empty Then
      '↑如果以T11變數 連接"|" 再連接T12變數的新字串,
      '查Y字典裡沒有這key??
         Application.GoTo Sheets("資料區").Rows(i)
         '↑令儲存格游標跳到i變數列
         MsgBox "無法沖帳": Exit Sub
         '↑跳出提示窗~~~:結束程式執行
      End If
   End If
   If T20 = "立帳" Then
   '↑如果T20變數 "立帳"字串
      N = Y(S1 & "|r"): N = N + 1: Y(S1 & "|r") = N
      '↑令N這長整數變數是 (S1變數連接"|r"成的新字串)查Y字典的item值
      '令N變數累加1,
      '令(S1變數連接"|r"成的新字串)的item值是 N變數
      S2 = T8 & "|" & T12: Y(S2) = N
      '↑令S2這字串變數是 T8變數 連接"|" 再連接T12變數的新字串,
      '↑令以S2變數當key,item是N變數,納入Y字典裡
      For x = 1 To 4: A(N, x) = Brr(i, Z(x)): Next
      '↑設順迴圈!x從1到4,令N變數列第x變數欄A陣列值是,
      '是i迴圈列第(Z陣列第x變數索引號值)欄Brr陣列值
      For x = 5 To 6
      '↑設順迴圈!x從5到6
         A(N, x) = Brr(i, Z(x)) + Brr(i, Z(x + 2))
         '↑令N變數列第x變數欄A陣列值是,
         '是i迴圈列第(Z陣列第x變數索引號值)欄Brr陣列值+
         'i迴圈列第(Z陣列(第x變數+2)索引號值)欄Brr陣列值
         A(N, x + 14) = A(N, x)
         '↑令N變數列第(x變數+14)欄A陣列值是 N變數列第x變數欄A陣列值
      Next
      Y(S1) = A: GoTo i01
      '↑令以S1變數為key,item是A陣列,納入Y字典(重複key則取代其item),
      '跳到 i01標示位置繼續執行
   End If
   C = Format(Brr(i, 4), "M") + 6
   '↑令C這短整數變數是 i迴圈列第4欄Brr陣列值取其日期月份後轉數字+6
   S2 = T11 & "|" & T12
   '↑令S2變數是 T11變數 連接"|" 再連接T12變數的新字串
   A(Y(S2), C) = Brr(i, 16) + Brr(i, 17)
   '↑令(S2變數當key查Y字典item值)列第C變數欄A陣列值是,
   '是i迴圈列第16欄Brr陣列值 + i迴圈列第17欄Brr陣列值欄Brr陣列值
   A(Y(S2), 20) = A(Y(S2), 20) - A(Y(S2), C)
   '↑令(S2變數當key查Y字典item值)列第20欄A陣列值是,
   '是自身陣列值 - (S2變數當key查Y字典item值)列第C變數欄A陣列值
   P = Brr(i, 14) + Brr(i, 15)
   '↑令P這長整數是 i迴圈列14欄Brr陣列值 + i迴圈列15欄Brr陣列值
   A(Y(S2), 19) = A(Y(S2), 19) - P
   '↑令(S2變數當key查Y字典item值)列第19欄A陣列值是,
   '是自身陣列值 - P變數
   Y(S1) = A
   '↑令以S1變數為key,item是A陣列,納入Y字典(重複key則取代其item)
   
i01:
Next
'====================================
For Each Yk In Y.keys
'↑設逐項迴圈!令Yk這通用型變數是Y字典裡key之一
   If IsArray(Y(Yk)) Then
   '↑如果以 Yk變數查Y字典的item值是 陣列?
      On Error Resume Next
      '↑令程序遇錯跳過!並繼續執行
      Sheets(Val(Yk) & "").Delete
      '↑令以Yk變數轉成數值再連接空字元的新字串的名字,
      '以此字串名字的工作表刪除
      On Error GoTo 0
      '↑令程序恢復正常偵錯
      Sheets("科目餘額表").Copy Before:=Sheets(1)
      '↑令科目餘額表另外複製一個同樣表放在最前面
      With Sheets(1)
      '↑以下是關於 最前面這工作表的程序
         .Name = Val(Yk)
         '↑令名字改為Yk變數轉化為數字的字串
         .UsedRange.Offset(5, 0).Delete
         '↑令有使用的儲存格範圍向下偏移5列的範圍刪除
         With .[A5].Resize(Y(Yk & "|r"), 20)
         '↑以下是關於表裡[A5]擴展向下Y(Yk & "|r")列,向右20欄範圍
         '關於這範圍儲存格的程序
         'Y(Yk & "|r"):是以Yk變數 連接"|r"的新字串查Y字典的item值
            .Value = Y(Yk)
            '↑令儲存格值是 以Yk變數查Y字典得到的陣列值
            Intersect([E:T], .Cells).NumberFormatLocal = _
            "_-* #,##0_-;-* #,##0_-;_-* ""-""??_-;_-@_-"
           '↑令[E:T]與此範圍儲存格交集的範圍儲存格格式是"~~~~~"
         End With
         .[C3] = Y(Yk & "/c")
         '↑令表裡[C3]儲存格值是 以Yk 連接"/c"字串成的新字串,
         '此字串查Y字典得到的 item值
         .[C3] = .[C3] & "《" & Y(Yk & "/b") & "》"
         '↑令表裡[C3]儲存格值是 自身字串 連接"《",
         '再連接 以Yk 連接"/c"字串成的新字串,最後連接"》" 成的新字串
         N = .Cells(Rows.Count, "F").End(3).Row
         '↑令N變數是F欄最後有內容儲存格列號
         With .Cells(N + 1, "F").Resize(1, 15)
         '↑以下是 關於表裡(N變數+1)列F欄儲存格擴展向右15欄的程序
            .Value = "=SUM(F5:F" & N & ")"
            '↑令這些儲存格值是 "=SUM(F5:F" 連接N變數 再連接")",
            '此連接成的新字串放入各儲存格後會因為最前面的"="符號,
            '裡面的欄位符號會隨各不同欄位做變化
            If .Item(14) <> .Item(15) Then .Item(14) = "NA"
            '↑如果結果表總餘額合計 S欄<>T欄!就讓S欄顯示 "NA"
            '否則S欄同T欄
         End With
      End With
   End If
Next
Set Y = Nothing: Erase Brr, Crr, Z, A
'↑令釋放變數
End Sub

Andy2483

回復 18# shuo1125


1.添加驗證 資料區總餘額與 科目餘額明細合計餘額,方案如下
2.資料區7407492改為7407491做驗證結果如下圖

下載 (180.67 KB)

2023-3-22 14:45

Option Explicit
Sub TEST()
Application.DisplayAlerts = False
Dim Brr, A, Y, Z, Yk, T2$, T3$, T8$, T11$, T12$, T20$, 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): Y(S1 & "/餘額") = Brr(i, 18)
   If Not IsArray(A) Then A = Crr
   T8 = Brr(i, 8): T11 = Brr(i, 11)
   T12 = Brr(i, 12): T20 = Brr(i, 20)
   If InStr("/沖帳/立帳/", "/" & T20 & "/") = 0 Then
      Application.GoTo Sheets("資料區").Rows(i)
      MsgBox "T欄不明 立沖帳類別": Exit Sub
   End If
   If T20 = "沖帳" Then
      If T11 Like "#####*" = False Then
         Application.GoTo Sheets("資料區").Rows(i)
         MsgBox "沖帳備註欄異常": Exit Sub
      End If
      If Y.Exists(T11 & "|" & T12) = Empty Then
         Application.GoTo Sheets("資料區").Rows(i)
         MsgBox "無法沖帳": Exit Sub
      End If
   End If
   If T20 = "立帳" 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"
            If Y(Yk & "/餘額") <> .Item(15) Then
               .Item(15)(2) = "↑嚴重錯誤!餘額合計" & _
               "不等於資料區餘額: " & vbLf & Y(Yk & "/餘額")
               .Interior.ColorIndex = 3
               MsgBox "嚴重錯誤"
               Exit Sub
            End If
         End With
      End With
   End If
Next
Set Y = Nothing: Erase Brr, Crr, Z, A
End Sub