[發問] 依據面額不同所需張數自動產生流水編號

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2025-8-22

2^#

發表於 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

帖子: 246
主題: 42
精華: 0
積分: 320
點名: 22
作業系統: XP
軟體版本: Office2007
閱讀權限: 20
註冊時間: 2015-2-20
最後登錄: 2025-10-20

3^#

發表於 2021-12-10 09:35 | 只看該作者

回復 2# samwang

感謝 samwang 熱心回覆

產生結果如下

似乎產生意外問題...

samwang

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2025-8-22

4^#

發表於 2021-12-10 09:54 | 只看該作者

回復 3# cypd

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

依據面額不同所需張數自動產生流水編號_1210.zip (25.5 KB)

ikboy

帖子: 262
主題: 8
精華: 0
積分: 280
點名: 0
作業系統: xp
軟體版本: Office 2007
閱讀權限: 20
性別: 男
來自: HK
註冊時間: 2015-8-11
最後登錄: 2025-3-24

2016猴年全勤獎章

5^#

發表於 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

複製代碼

zz.zip (14.04 KB)

hcm19522

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

帖子: 1451
主題: 18
精華: 0
積分: 1475
點名: 0
作業系統: WIN
軟體版本: 2007
閱讀權限: 50
性別: 男
註冊時間: 2015-9-11
最後登錄: 2025-11-4

熱烈參與勳章

6^#

發表於 2021-12-10 10:57 | 只看該作者

google"EXCEL迷" blog 或google網址:https://hcm19522.blogspot.com/

cypd

帖子: 246
主題: 42
精華: 0
積分: 320
點名: 22
作業系統: XP
軟體版本: Office2007
閱讀權限: 20
註冊時間: 2015-2-20
最後登錄: 2025-10-20

7^#

發表於 2021-12-10 12:28 | 只看該作者

回復 4# samwang

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

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

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

cypd

帖子: 246
主題: 42
精華: 0
積分: 320
點名: 22
作業系統: XP
軟體版本: Office2007
閱讀權限: 20
註冊時間: 2015-2-20
最後登錄: 2025-10-20

8^#

發表於 2021-12-10 13:35 | 只看該作者

回復 5# ikboy

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

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

cypd

帖子: 246
主題: 42
精華: 0
積分: 320
點名: 22
作業系統: XP
軟體版本: Office2007
閱讀權限: 20
註冊時間: 2015-2-20
最後登錄: 2025-10-20

9^#

發表於 2021-12-10 13:55 | 只看該作者

回復 6# hcm19522

感恩 hcm19522 回覆指導

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

samwang

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2025-8-22

10^#

發表於 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