返回列表 上一主題 發帖

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

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

依據面額不同所需張數自動產生流水編號
希望結果:
09.jpg
2021-12-9 21:51


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

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

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

1209.rar (6.9 KB)

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

TOP

回復 2# samwang

感謝  samwang  熱心回覆

產生結果如下
10.jpg
2021-12-10 09:34


似乎產生意外問題...

TOP

回復 3# cypd

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

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

TOP

  1. Function zz(面額, 張數)
  2. Dim rng As Range, n&, r&, c&, b, x, i&
  3. r = 張數.Row
  4. c = 張數.Column
  5. b = Cells(1, c + 1).Resize(r - 1)
  6. Select Case 面額
  7.     Case 100: x = "A"
  8.     Case 500: x = "B"
  9. End Select
  10. For i = 1 To UBound(b)
  11.     If Left(b(i, 1), 1) = x Then n = i
  12. Next
  13. If n Then i = Mid(b(n, 1), Application.Find(x, b(n, 1), 2) + 1) Else i = 0
  14. zz = x & Format(i + 1, "0000000") & "-" & x & Format(i + 張數, "0000000")
  15. End Function
複製代碼

zz.zip (14.04 KB)

TOP

隨意窩 "EXCEL迷"  blog  或https://blog.xuite.net/hcm19522/twblog
已收集8500篇 EXCEL函數

TOP

回復 4# samwang

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

10.jpg
2021-12-10 12:23


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

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

TOP

回復 5# ikboy

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

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

TOP

回復 6# hcm19522

感恩 hcm19522  回覆指導

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

TOP

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

TOP

        靜思自在 : 吃苦了苦、苦盡廿來,享福了福、福盡悲來。
返回列表 上一主題