cypd

回復 30# 准提部林

真是太強了!!  感謝 版主 准提部林 ...^^

版主加強了以下公式
Sub 流水編號1()
Dim Arr, i&, P%, V&, N&, T1$, T2$, TT$, x%, Y&, SS(2)
Arr = Range([c1], [b65536].End(xlUp)(1, 0))
For i = 3 To UBound(Arr)
    If Arr(i, 1) = "合計" Then Exit For
    N = N + 1: Arr(i - 2, 1) = ""
    P = Val(Arr(i, 2)): V = Val(Arr(i, 3))
    x = Switch(P = 100, 1, P = 200, 2, P = 500, 2, P = P, 0)
    If P = 0 Or V = 0 Or x = 0 Then GoTo i01
    Y = Array(64564, 81140)(x - 1): TT = Array("A", "B")(x - 1)
    T1 = TT & Format(Y + SS(x) + 1, "0000000")
    T2 = TT & Format(Y + SS(x) + V, "0000000")
    Arr(i - 2, 1) = T1 & IIf(T1 = T2, "", "-" & T2)
    SS(x) = SS(x) + V
i01: Next i
[d3].Resize(N) = Arr
End Sub

所述問題已完美處理...感恩

下載 (75.02 KB)

2021-12-15 12:57

關於函數公式 REPLACE(TEXT(MMULT((IF(B3=100,64564,81140)+SUMIF(B$2:B2,B3,C$2:C2)+C3^{0,1}),10^{7;0}),REPT(IF(B3=100,"A","B")&"0000000",2)),9,,"-")

下載 (177.08 KB)

2021-12-15 13:00

此問題有其他方式可修正嗎??

准提部林

回復 31# cypd


都是最普通的函數, 會有一個正常,一個錯誤值, 也許借別人的電腦試試,
可能要重新安裝EXCEL

cypd

回復 32# 准提部林

非常感謝您

該檔案以
家中桌機*1(WIN7+2013)+筆電*2(WIN10+2013 and WIN7+2016)
公司桌機*1(WIN10+2010)

測試結果面額  500 之儲存格出現 #VALUE!  之問題仍一樣存在...

Andy2483

回復 30# 准提部林


    謝謝論壇,謝謝前輩指導
後學學習前輩的方案,心得註解如下,請前輩再指導

Sub 流水編號1()
Dim Arr, i&, V&, N&, Y&, T1$, T2$, TT$, P%, x%, SS(2)
'↑宣告變數:Arr是通用型變數,(i,V,N,Y)是長整數變數,(T1,T2,TT)是字串變數,
'(P,x)是短整數變數,SS是一維陣列(索引號0~2)
Arr = Range([c1], [b65536].End(xlUp)(1, 0))
'↑令Arr這通用型變數是二維陣列,以[C1]到 B欄最後有內容儲存格左側格(A欄),
'以這範圍儲存格值帶入陣列中
For i = 3 To UBound(Arr)
'↑設順迴圈!i從3到Arr陣列縱向最大索引列號
    If Arr(i, 1) = "合計" Then Exit For
    '↑如果i迴圈列第1欄Arr陣列值是 "合計"? True就結束迴圈執行
    N = N + 1: Arr(i - 2, 1) = ""
    '↑令N這長整數變數累加 1
    '令(i迴圈-1)列第1欄Arr陣列值是 空字元
    P = Val(Arr(i, 2)): V = Val(Arr(i, 3))
    '↑令P這短整數是i迴圈列第2欄Arr陣列值
    '令V這長整數是i迴圈列第3欄Arr陣列值
    x = Switch(P = 100, 1, P = 200, 2, P = 500, 2, P = P, 0)
    '↑令x這短整數是Switch()函式回傳值
    https://learn.microsoft.com/zh-t ... elp/switch-function
    If P = 0 Or V = 0 Or x = 0 Then GoTo i01
    '↑如果P變數是0 或V是0 又或x是0,其中一條件成立!就跳到 標示i01的位置繼續執行
    Y = Array(64564, 81140)(x - 1): TT = Array("A", "B")(x - 1)
    '↑令Y這長整數變數是 一維陣列的索引號(x變數-1)陣列值
    '令TT這字串變數變數是 一維陣列的索引號(x變數-1)陣列值
    T1 = TT & Format(Y + SS(x) + 1, "0000000")
    '↑令T1變數是 TT變數連接 (Y變數+x索引號SS陣列值再+1)轉成7碼數值,所組成的新字串
    T2 = TT & Format(Y + SS(x) + V, "0000000")
    '↑令T2變數是 TT變數連接 (Y變數+x索引號SS陣列值再+V變數)轉成7碼數值,所組成的新字串
    Arr(i - 2, 1) = T1 & IIf(T1 = T2, "", "-" & T2)
    '↑令(i迴圈-2)列第1欄Arr陣列值是 T1變數連接 空字元或 ("-"連接T2變數組成字串)
    'IIf():如果T1變數同T2變數(即張數是1張)!就回傳 空字元,否則回傳字串
    SS(x) = SS(x) + V
    '↑令x變數索引號SS陣列值是 累加V變數的數值
i01: Next i
[d3].Resize(N) = Arr
'↑令[D3]擴展向下 N變數列儲存格值 以Arr陣列值帶入
End Sub
'============================================================

Option Explicit
Sub TEST()
Dim Brr, E, P, Q&, i&, H&, c, K%, S&(1), T$, Ts$, Te$
c = Application.Match("合計", [A:A], 0)
If IsError(c) Then Exit Sub
Brr = [B3].Resize(c - 3, 3)
E = Array(64564, 81140): P = Array("A", "B")
For i = 1 To UBound(Brr)
   Q = Val(Brr(i, 1)): H = Val(Brr(i, 2))
   K = Switch(Q = 100, 0, InStr("200/500", Q), 1, Q = Q, -1)
   T = P(K) & "0000000": Brr(i, 1) = ""
   If (Q = 0) + (H = 0) + (K = -1) < 0 Then GoTo i01
   S(K) = E(K) + 1: E(K) = E(K) + H
   Ts = Format(S(K), T): Te = Format(E(K), T)
   Brr(i, 1) = Ts & IIf(S(K) = E(K), "", "-" & Te)
   S(K) = E(K)
i01: Next
[I3].Resize(UBound(Brr)) = Brr
End Sub

hcm19522

(輸入編號11999) google網址:https://hcm19522.blogspot.com/

cypd

回復 35# hcm19522

感謝 hcm19522  熱心指導
可適用各種幣值張數流水編號呢  ^^

cypd

回復 34# Andy2483

非常感謝  Andy2483 提供的詳細解說程式碼代表含意及相關VBA...
若是因另有需要時
所需面額 同時含有  100  200  500  1000  ...各種面額時(前字軌英文字母各不同)
100(A0000125)  200(B0000100)  500(C0000085)  1000(D0000055)

該如何修正 ??

Andy2483

回復 37# cypd


    謝謝前輩回復
後學藉此帖練習陣列與字典,學習方案如下,請前輩參考
20231115.zip (13.71 KB)

下載次數: 3

2023-11-15 08:43

執行前:

下載 (79.21 KB)

2023-11-15 08:42

執行結果:

下載 (115.63 KB)

2023-11-15 08:42

Option Explicit
Sub TEST_1()
Dim Brr, Z, C, A(2), P%, Q%, i%, V%, F$, T$, Ts$, Te$
Set Z = CreateObject("Scripting.Dictionary")
C = Application.Match("合計", [A:A], 0)
If IsError(C) Then Exit Sub Else F = "0000000"
Brr = [B3].Resize(C - 3, 3)
A(0) = [{1,2,5,10}]
A(1) = [{124,99,84,54}]
A(2) = [{"A","B","C","D"}]
For i = 1 To UBound(A(0)):
   Q = A(0)(i) * 100: Z(Q) = A(1)(i): Z(Q & "") = A(2)(i)
Next
For i = 1 To UBound(Brr)
   P = Brr(i, 1): V = Z(P): T = Z(P & "")
   Ts = T & Format((V + 1), F)
   V = V + Brr(i, 2): Z(P) = V
   Te = T & Format((V), F)
   Brr(i, 1) = Ts & "-" & Te
Next
[D3].Resize(UBound(Brr)) = Brr
End Sub

cypd

回復 38# Andy2483

再感謝  Andy2483 熱心提供的詳細VBA...
1.新增 J2:L6 面額相關流水編號資訊(希望以此資訊欄位數據為主)
2.面額張數有 0 出現之情形...
3.面額幣值部分 A(0) = [{1,2,5,10}]…Q = A(0)(i) * 100: Z(Q) = A(1)(i): Z(Q & "") = A(2)(i)
  不解為何是 [{1,2,5,10}]…Q = A(0)(i) * 100 的方式?不是直接以 100 200 500 1000…方式呈現

下載 (125.28 KB)

2023-11-15 14:18

20231115+.rar (13.5 KB)

下載次數: 2

2023-11-15 14:19

Andy2483

回復 39# cypd


    謝謝論壇,謝謝前輩指導
後學藉此帖練習修改新方案,學習到很多知識,請前輩再指導

20231115+_20231115.zip (15.48 KB)

下載次數: 4

2023-11-15 16:39

執行前:

下載 (154.95 KB)

2023-11-15 16:40

執行3次:

下載 (211.91 KB)

2023-11-15 16:40

Option Explicit
Sub TEST_1()
Dim Brr, Z, C, A(2), P1&, P2&, Q%, i&, j%, V&, F$, T$, Ts$, Te$, R&, U%
Set Z = CreateObject("Scripting.Dictionary")
U = [IV2].End(xlToLeft).Column: Brr = Range(Cells(2, U), [H65536].End(3)(1, 2))
For j = 1 To UBound(Brr, 2): Z(Val(Brr(1, j))) = Val(Brr(UBound(Brr), j)): Next
For j = 0 To UBound(Z.KEYS()): Z(Z.KEYS()(j) & "") = Brr(2, j + 1): Next
R = UBound(Brr): C = Application.Match("合計", [A:A], 0)
If IsError(C) Then Exit Sub Else F = Application.Rept("0", 7)
Brr = [B3].Resize(C - 3, 3)
For i = 1 To UBound(Brr)
   P1 = Val(Brr(i, 1)): P2 = Val(Brr(i, 2)): Brr(i, 1) = ""
   If P1 * P2 = 0 Then GoTo i01
   V = Z(P1): T = Z(P1 & ""): If V = 0 Then GoTo i01
   Ts = T & Format((V + 1), F)
   V = V + Brr(i, 2): Z(P1) = V
   Te = T & Format((V), F)
   Brr(i, 1) = Ts & "-" & Te
i01: Next
[D3].Resize(UBound(Brr)) = Brr
Cells(R + 2, "I").Resize(1, U - 8) = Z.ITEMS: Cells(R + 2, "I").Item(1, 0) = Now
End Sub