麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 依據面額不同所需張數自動產生流水編號 [打印本頁]

作者: cypd 時間: 2021-12-9 21:51 標題: 依據面額不同所需張數自動產生流水編號

依據面額不同所需張數自動產生流水編號
希望結果:
[attach]34494[/attach]

C 欄輸入張數...面額100 編號由 A0064565起算
D欄能自動產生所需張數編號 A0064565~A0066053

面額500 編號由 B0081141起算
D欄能自動產生所需張數編號 B0081141~B0084118

請問D欄能自動產生所需張數編號公式該如何設定...

[attach]34495[/attach]

作者: samwang 時間: 2021-12-10 08:33

回復 1# cypd

請測試看看，謝謝
Sub test()
Dim Arr, xD, Brr, T, T1, TT$, ck%, ck1%, i&
Set xD = CreateObject("Scripting.Dictionary")
With Range([D2], [B65536].End(3))
Brr = .Value
.Sort Key1:=.Item(1), Order1:=1, Header:=1
Arr = .Value
For i = 2 To UBound(Arr)
      TT = Arr(i, 1) & "|" & Arr(i, 2)
      If Arr(i, 1) = 100 Then
         If ck = 0 Then
            T = 64565
            Arr(i, 3) = "A00" & T & "-" & Format(T + Arr(i, 2) - 1, "A0000000")
            ck = 1: T1 = T + Arr(i, 2): xD(TT) = Arr(i, 3)
         Else
            Arr(i, 3) = "A00" & T1 & "-" & Format(T1 + Arr(i, 2) - 1, "A0000000")
            T1 = T1 + Arr(i, 2): xD(TT) = Arr(i, 3)
         End If
      ElseIf Arr(i, 1) = 500 Then
         If ck1 = 0 Then
            T = 81141
            Arr(i, 3) = "B00" & T & "-" & Format(T + Arr(i, 2) - 1, "B0000000")
            ck1 = 1: T1 = T + Arr(i, 2): xD(TT) = Arr(i, 3)
         Else
            Arr(i, 3) = "B00" & T1 & "-" & Format(T1 + Arr(i, 2) - 1, "B0000000")
            T1 = T1 + Arr(i, 2): xD(TT) = Arr(i, 3)
         End If
      End If
Next
For i = 2 To UBound(Brr): TT = Brr(i, 1) & "|" & Brr(i, 2): Brr(i, 3) = xD(TT): Next
.Value = Brr
End With
End Sub

作者: cypd 時間: 2021-12-10 09:35

回復 2# samwang

感謝 samwang 熱心回覆

產生結果如下
[attach]34496[/attach]

似乎產生意外問題...

作者: samwang 時間: 2021-12-10 09:54

回復 3# cypd

我測試沒問題如附件，請再測試看看，謝謝

作者: ikboy 時間: 2021-12-10 10:09

Function zz(面額, 張數)
Dim rng As Range, n&, r&, c&, b, x, i&
r = 張數.Row
c = 張數.Column
b = Cells(1, c + 1).Resize(r - 1)
Select Case 面額
Case 100: x = "A"
Case 500: x = "B"
End Select
For i = 1 To UBound(b)
If Left(b(i, 1), 1) = x Then n = i
Next
If n Then i = Mid(b(n, 1), Application.Find(x, b(n, 1), 2) + 1) Else i = 0
zz = x & Format(i + 1, "0000000") & "-" & x & Format(i + 張數, "0000000")
End Function

複製代碼

作者: hcm19522 時間: 2021-12-10 10:57

https://blog.xuite.net/hcm19522/twblog/590165834

作者: cypd 時間: 2021-12-10 12:28

回復 4# samwang

感謝 samwang 指導
不好意思原來問提出現如下

[attach]34500[/attach]

面額200之張數系100之張數 X 2 所得(問題所在-已手動輸入取消*2)

若是面額計算範圍只至 B18 儲存格，公式該如何修正?

作者: cypd 時間: 2021-12-10 13:35

回復 5# ikboy

非常感謝 ikboy 的指導
關於使用函數(Function) 之方式...不清楚使用方式

第一筆該如何起始?? =ZZ(B3,C3) (編號 A0064565起算在何處設定?)

作者: cypd 時間: 2021-12-10 13:55

回復 6# hcm19522

感恩 hcm19522 回覆指導

所需流水編號依所指導順利完成...感恩 ^^

作者: samwang 時間: 2021-12-10 14:04

回復 7# cypd

面額200之張數系100之張數 X 2 所得(問題所在-已手動輸入取消*2)
>> 修改如下紅字，請測試看看，謝謝

Sub test()
Dim Arr, xD, Brr, T, T1, TT$, ck%, ck1%, i&
Set xD = CreateObject("Scripting.Dictionary")
With Range([D2], [B65536].End(3))
Brr = .Value
.Sort Key1:=.Item(1), Order1:=1, Header:=1
Arr = .Value
For i = 2 To UBound(Arr)
      TT = Arr(i, 1) & "|" & Arr(i, 2)
      If Arr(i, 1) = 100 Then
         If ck = 0 Then
            T = 64565
            Arr(i, 3) = "A00" & T & "-" & Format(T + Arr(i, 2) - 1, "A0000000")
            ck = 1: T1 = T + Arr(i, 2): xD(TT) = Arr(i, 3)
         Else
            Arr(i, 3) = "A00" & T1 & "-" & Format(T1 + Arr(i, 2) - 1, "A0000000")
            T1 = T1 + Arr(i, 2): xD(TT) = Arr(i, 3)
         End If
      ElseIf Arr(i, 1) = 200 Then
         If ck1 = 0 Then
            T = 81141
            Arr(i, 3) = "B00" & T & "-" & Format(T + Arr(i, 2) - 1, "B0000000")
            ck1 = 1: T1 = T + Arr(i, 2): xD(TT) = Arr(i, 3)
         Else
            Arr(i, 3) = "B00" & T1 & "-" & Format(T1 + Arr(i, 2) - 1, "B0000000")
            T1 = T1 + Arr(i, 2): xD(TT) = Arr(i, 3)
         End If
      End If
Next
For i = 2 To UBound(Brr): TT = Brr(i, 1) & "|" & Brr(i, 2): Brr(i, 3) = xD(TT): Next
.Value = Brr
End With
End Sub

作者: ikboy 時間: 2021-12-10 16:05

回復 5# ikboy

化碼基本上是追蹤對上一次的號碼，在没有的情調下從1開始，若一定在没有對上一次的號碼，要用指定的號碼，可以在 13 行 else 後面的 i 做修改。

作者: cypd 時間: 2021-12-10 22:44

回復 11# ikboy

感謝 ikboy 的說明

針對第一筆面額100流水號由 A0064565起始 =ZZ(B3,C3)

說明 13 行 else 後面的 i 做修改...
If n Then i = Mid(b(n, 1), Application.Find(x, b(n, 1), 2) + 1) Else i = 64564

提問第二筆面額200流水號由 B0081141起始，該數據需在何處修改?

作者: cypd 時間: 2021-12-10 23:01

回復 10# samwang

非常感謝 samwang 指導

上面公式若是 B19 B20 儲存格無數據執行巨集公式答案正常顯示!!

現因 B19 B20 儲存格有相關面額數據(100 200) 如7樓圖
[attach]34503[/attach]

導致上述公式無法正常產生流水編號…該如何修正??感謝

作者: samwang 時間: 2021-12-11 07:37

回復 13# cypd

現因 B19 B20 儲存格有相關面額數據(100 200) 如7樓圖
>>請測試看看，謝謝
Sub test()
Dim Arr, xD, Brr, T, T1, TT$, ck%, ck1%, i&
Set xD = CreateObject("Scripting.Dictionary")
With Range([D2], [B65536].End(3)-2)
Brr = .Value
.Sort Key1:=.Item(1), Order1:=1, Header:=1
...
...

作者: 准提部林 時間: 2021-12-11 19:17

=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,,"-")

作者: cypd 時間: 2021-12-13 03:11

回復 14# samwang

不好意思!針對所述問題

依閣下指導公式修改之後執行產生錯誤如下
[attach]34510[/attach]
錯誤訊息
[attach]34511[/attach]

附上檔案供參...

[attach]34512[/attach]

作者: cypd 時間: 2021-12-13 03:22

回復 15# 准提部林

非常感謝准提部林指導

將所述公式函數代入面額 100 之流水編號全不正常顯示所需結果

面額 500 之儲存格出現 #VALUE! 之問題

[attach]34513[/attach]

附上問題檔案供參

[attach]34514[/attach]

作者: samwang 時間: 2021-12-13 07:17

回復 16# cypd
依閣下指導公式修改之後執行產生錯誤如下
>> 請再測試看看，謝謝
Sub test()
Dim Arr, xD, Brr, T, T1, TT$, ck%, ck1%, i&
Set xD = CreateObject("Scripting.Dictionary")
With Range("b2:d" & [B65536].End(3).Row - 2)
Brr = .Value
.Sort Key1:=.Item(1), Order1:=1, Header:=1
Arr = .Value
For i = 2 To UBound(Arr)
      TT = Arr(i, 1) & "|" & Arr(i, 2)
      If Arr(i, 1) = 100 Then
         If ck = 0 Then
            T = 64565
            Arr(i, 3) = "A00" & T & "-" & Format(T + Arr(i, 2) - 1, "A0000000")
            ck = 1: T1 = T + Arr(i, 2): xD(TT) = Arr(i, 3)
         Else
            Arr(i, 3) = "A00" & T1 & "-" & Format(T1 + Arr(i, 2) - 1, "A0000000")
            T1 = T1 + Arr(i, 2): xD(TT) = Arr(i, 3)
         End If
      Else
         If ck1 = 0 Then
            T = 81141
            Arr(i, 3) = "B00" & T & "-" & Format(T + Arr(i, 2) - 1, "B0000000")
            ck1 = 1: T1 = T + Arr(i, 2): xD(TT) = Arr(i, 3)
         Else
            Arr(i, 3) = "B00" & T1 & "-" & Format(T1 + Arr(i, 2) - 1, "B0000000")
            T1 = T1 + Arr(i, 2): xD(TT) = Arr(i, 3)
         End If
      End If
Next
For i = 2 To UBound(Brr): TT = Brr(i, 1) & "|" & Brr(i, 2): Brr(i, 3) = xD(TT): Next
.Value = Brr
End With
End Sub

作者: samwang 時間: 2021-12-13 07:49

回復 16# cypd

18#除了更新列數問題，因為你的B欄除了500元有時又會有200元問題(代碼都是共用B開頭)，也有更新此問題，謝謝

作者: 准提部林 時間: 2021-12-13 10:17

回復 17# cypd

不知道是否檔案格式問題,
我這邊重新下拉公式, 或C3重新輸入, 都可以正常!!!

作者: cypd 時間: 2021-12-13 12:24

回復 18# samwang

真是太神奇了  ^^
非常感謝  samwang  不吝指導...感恩

所述問題以迎刃而解還通用面額 200 or  500  之方式公式

再度感謝...水啦

作者: cypd 時間: 2021-12-13 12:28

回復 20# 准提部林

非常感謝准提部林指導

所述問題檔案是 office 2013 版本所製作產生
不知問題是否與版本有關?

作者: cypd 時間: 2021-12-13 14:48

回復 20# 准提部林

剛剛測試 office 2010及2013版的版本皆為一樣的問題
是否能請版主准提部林提供正確檔案參考...

作者: 准提部林 時間: 2021-12-13 15:42

回復 23# cypd

2000版做的, 公式及vba各一:
[attach]34515[/attach]

作者: 准提部林 時間: 2021-12-13 16:41

若想100,200,500分別編碼:
Sub 流水編號()
Dim Arr, i&, P%, V&, N&, T1$, T2$, x%, TR, YR, SS&(3)
Arr = Range([c1], [b65536].End(xlUp)(1, 0))
TR = [{"A","F","B"}]
YR = [{64564,38000, 81140}]
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, 3, P = P, 0)
If P = 0 Or V = 0 Or x = 0 Then GoTo i01
T1 = TR(x) & Format(YR(x) + SS(x) + 1, "0000000")
T2 = TR(x) & Format(YR(x) + 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

作者: cypd 時間: 2021-12-14 00:39

回復 25# 准提部林

非常感謝准提部林提供公式及 VBA 兩種方式做參考

唯一不解的是公式裡出現的 #VALUE! 之問題???

下圖是版主提供的檔案公式工作表呈現一樣的問題

[attach]34516[/attach]

作者: cypd 時間: 2021-12-14 00:58

回復 25# 准提部林

提問
公式中

[attach]34517[/attach]
TR = [{"A","F","B"}]
YR = [{64564,38000, 81140}]

x = Switch(P = 100, 1, P = 200, 2, P = 500, 3, P = P, 0)

面額100是由A645645起算
面額200是由F38001起算 ??? (是這樣解讀嗎?)
面額500是由B81141起算

作者: 准提部林 時間: 2021-12-14 10:44

回復 27# cypd

是的~~
給變數, 再引用陣列中的元素

作者: cypd 時間: 2021-12-15 01:11

回復 25# 准提部林

若想100,200,500分別編碼:
使用 XX20211213v01(分類流水號) 檔案

所得結果如下:

[attach]34521[/attach]

流水編號並未如其按 100,200,500分別編碼
面額100是由A645645起算
面額200是由F38001起算 ??? (流水編號有問題)
面額500是由B81141起算

作者: 准提部林 時間: 2021-12-15 10:46

回復 29# cypd

應該是你檔案問題, 傳檔案看看~~~
[attach]34523[/attach]

作者: cypd 時間: 2021-12-15 13:01

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

所述問題已完美處理...感恩
[attach]34525[/attach]

關於函數公式 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,,"-")
[attach]34526[/attach]
此問題有其他方式可修正嗎??

作者: 准提部林 時間: 2021-12-15 17:55

回復 31# cypd

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

作者: cypd 時間: 2021-12-16 00:12

回復 32# 准提部林

非常感謝您

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

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

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)