孫守真任真甫大大，首先必須感謝您這麼有耐心的一再修改程式來幫助我，真的非常感謝!
為了讓您能夠了解我當初製作這個表時的邏輯想法，再此回覆末尾附上我的範例檔案供您參考。
其實您上述提到的部分已與我當初用公式製作時的想法很接近，要使用者可以輸入流水號，但不能輸入分單號。在使用者輸入完流水號後，才由程式自動賦予不重號的分單號，是這樣嗎？？？這樣要怎麼確定使用者真的輸入完流水號，而不再改變了呢？還是希望使用者可以輸入改變
我之前一直沒有提到的地方，是關於編號自動生成的部分，再說這部分之前，先解答您上述的疑問"要使用者可以輸入流水號，但不能輸入分單號。在使用者輸入完流水號後，才由程式自動賦予不重號的分單號，是這樣嗎？？？這樣要怎麼確定使用者真的輸入完流水號，而不再改變了呢？還是希望使用者可以輸入改變"

1. 為什麼流水號會有兩個欄位：因為會出現相同流水號的情況，當有相同流水號時，若流水號無法手動修改，分單號就不會變化跳號(分單號是依據流水號來作判別)，因此需要有兩個欄位來做變化，一個是手動輸入，另一個欄位則是程式依據已輸入的字串作判別後**"顯示當前已編到的流水號碼"**
   真正決定流水號的是手動輸入的欄位(圖一的C9欄位)，程式判別那欄只作當前最新編號的顯示(圖一的G9欄位)
2. 同樣的想法，其實分單號也是兩個欄位(都是由程式判別，使用者無法手動修改，這是為了避免重號)，您在圖一所看到的紅字非白底的是程式判別後顯示當前最新分單號(圖一的M9欄位)，
   接下來要說的就是編號生成的部分，分單號的第二個欄位，就是在編號生成的這個欄位裡出現(圖一的C11欄位裡編號的最後一碼)，這裡同樣是由程式判別，依據C9欄位的流水號作判別後產生變化，當C9欄位所輸入的流水號與總表(圖二)相同時，這個欄位所生成的編號，在最後一碼分單號的部分就要自動跳號，若是新的流水號，那分單號就從"0"開始

我自知自己的表達能力欠缺，故詳細的功能您可以透過底下的範例檔案來測試，若還有疑問，是否能與您再約個時間透過線上會議之類的方式來做說明，以上，謝謝您。

訂單編號範例檔案

Bobo0509菩薩慈悲：

今天(3/23)晚上有空嗎？先會議解決以下問題，好嗎？現在Google Meet有時間限制了。所以先約好時間，您發起會議給我連結。感恩。我晚上7點再來看您回覆沒。或您方便時，到臉書Messenger敲我。感謝

1.【真正決定流水號的是手動輸入的欄位(圖一的C9欄位)，程式判別那欄只作當前最新編號的顯示(圖一的G9欄位)】
所以C9是顯示到底是可以編的新號（容許使用者輸入的新號，即尚未編入編號者），還是最後編的舊號？（請明示！）
2.同樣的【在圖一所看到的紅字非白底的是程式判別後顯示當前最新分單號(圖一的M9欄位)，】所以，M9也是可以用的新號，而不是舊有最後的一號嗎？
★我看您圖一與範例檔分明G9與M9是舊有最後（或最近）的流水號與分單號嘛！為什麼說「顯示當前最新分單號」？您所謂的「最新」是舊有的最近（新）嗎？不是可編的新號吧。請以上2個疑問一定要先搞定，我才會繼續下去，免得又白做了。（我有空妳又還沒回覆的話，會用舊有的最後一筆編號來算，而不是顯示新的可輸入的編號}）感恩感恩　南無阿彌陀佛
3.為什麼分單號還要分兩個欄位？明明一個欄位便可敷用了……這裡末學還是感到很困惑也奇怪！您所謂的兩個欄位，第2個是N9（與O9合併？）嗎。但您回應說明裡又說和C11有關（是C11D11到G11合併或跨欄的欄位吧？）這個C11為什麼不用「訂單總表」工作表中的訂單編號欄位值或訂單表顯示內容欄位半形空格前的值回傳就好？還有「訂單總表」為什麼訂單編號欄位和訂單表顯示內容欄位所顯示的值又不同了呢？前者是舊號，後者是取得使用輸入後新編而加入記錄的編號嗎？請菩薩您務必先回答以上問題。感恩感恩

●有實際的範例檔就好操作多了，不但能具體掌握您應用程式的流程邏輯，我也可以直接把程式碼掛上去測試。您早該給我了。我先試試吧。但可能得請菩薩您稍安勿躁，畢竟前面徒勞往返白費了許多心思，我還有別的要忙，餘暇才能分神理會。想能見諒。感恩感恩　南無阿彌陀佛

4.我看到「CommandButton1_Click」，這個按鍵就是使用者確定輸入完時的動作嗎？也就是按下就不會再更改編號記錄中的記錄了。是嗎？而不是在C9更動/輸入後。是這樣嗎？這很重要，就是我前面提到的程式碼更新編號記錄的時機點。

> 今天晚上7點半可以的，我再透過您說的方式聯繫您，謝謝

抱歉，可能是我的用詞產生誤會...在這裡先向您道歉
1.【真正決定流水號的是手動輸入的欄位(圖一的C9欄位)，程式判別那欄只作當前最新編號的顯示(圖一的G9欄位)】
所以C9是顯示到底是可以編的新號（容許使用者輸入的新號，即尚未編入編號者），還是最後編的舊號？（請明示！）
在我的想法裡，"顯示最新編號"是指總表裡最後編到的號碼，例如{在不考慮手動輸入流水號的情況下}總表裡訂單編號的流水號最後一號為056，那新的流水號正常就會是057，在圖一的G9欄位會顯示"056"，在圖一C11到G11合併的欄位裡，流水號會顯示057(讓使用者確認，避免重號)

2.同樣的【在圖一所看到的紅字非白底的是程式判別後顯示當前最新分單號(圖一的M9欄位)，】所以，M9也是可以用的新號，而不是舊有最後的一號嗎？
★我看您圖一與範例檔分明G9與M9是舊有最後（或最近）的流水號與分單號嘛！為什麼說「顯示當前最新分單號」？您所謂的「最新」是舊有的最近（新）嗎？不是可編的新號吧。
在圖一M9欄位裡，同樣是只顯示總表裡最後編到的號碼(為讓使用者確認)
真正新編的編號會出現在圖一C11到G11合併的欄位裡

3.為什麼分單號還要分兩個欄位？明明一個欄位便可敷用了……這裡末學還是感到很困惑也奇怪！您所謂的兩個欄位，第2個是N9（與O9合併？）嗎。但您回應說明裡又說和C11有關（是C11D11到G11合併或跨欄的欄位吧？）這個C11為什麼不用「訂單總表」工作表中的訂單編號欄位值或訂單表顯示內容欄位半形空格前的值回傳就好？
3.1.這範例裡的表改過很多次，自己本身對excel並不精通，加上測試時有出現重號或是不知道總表已編到的最後一號為何?才會使用兩個欄位，
從圖一的M9欄位顯示總表最後編到的分單號，在圖一的C11到G11合併欄位裡顯示新編的訂單編號(未增列到總表裡的編號，待新增的新編號)
還有「訂單總表」為什麼訂單編號欄位和訂單表顯示內容欄位所顯示的值又不同了呢？前者是舊號，後者是取得使用輸入後新編而加入記錄的編號嗎？
3.2.在圖一的C11到G11合併欄位裡顯示新編的訂單編號(未增列到總表裡的編號，待新增的新編號)
而總表裡的是已經建立過的編號(舊號)，類似資料庫的記錄數據

4.我看到「CommandButton1_Click」，這個按鍵就是使用者確定輸入完時的動作嗎？也就是按下就不會再更改編號記錄中的記錄了。是嗎？而不是在C9更動/輸入後。是這樣嗎？這很重要，就是我前面提到的程式碼更新編號記錄的時機點。
4.1.沒有按下CommandButton1_Click按鍵確認建立前，手動輸入的C9欄位，只會影響，"M9欄位"與"C11到G11合併的欄位"所顯示的號碼，不會影響到總表裡的內容；
4.2.在登記表輸入完待新編的內容後，按下CommandButton1_Click按鍵，確定新增後，才會將登記表中的內容增加到總表裡，變成一筆新的數據。
只要沒有按下CommandButton1_Click按鍵，登記表裡的內容再怎麼變動，都不會影響到總表。

我怕我又表達得不清楚，只能麻煩您從範例檔裡測試看看，實在抱歉花費您這麼多的精力和時間，也很感謝您的回覆。

Bobo0509那什麼時候顯示出紅字的部分（G9、M9、N9）呢？是確認H5、M5、C7、H7（即編號前綴）都輸入了有資料之後嗎？還是有上述哪個儲存格輸入完後（比如H7），才顯示舊有記錄的編號現況？因為必須取得上述4個前綴參考的儲存格值才能去判斷已存在的流水號的編號情況。
至於M9的顯示，要與C9 同步同時，還是在流水號有資料輸入後才顯示呢？又是否要依流水號的輸入情況，再依其輸入之值判斷分單號的顯示值呢 請菩薩您明示
確定上述情況，我就大致懂了。感恩感恩　南無阿彌陀佛

1.那什麼時候顯示出紅字的部分（G9、M9、N9）呢？是確認H5、M5、C7、H7（即編號前綴）都輸入了有資料之後嗎？還是有上述哪個儲存格輸入完後（比如H7），才顯示舊有記錄的編號現況？
範例檔案裡，我用公式判別時，是以H5、C7當作基準(H5、C7有資料輸入)，圖三的D1欄位才會將圖一的H5、M5、C7、H7、C9組合起來作為判別字串，再從這組字串去作延伸和公式判別計算
可以先將圖一的C9當作基準，C9無資料輸入時，G9、M9、N9、C11不顯示，設定後測試看看有沒有問題，我自己列公式時也是反覆測試，所以無法完全保證，以C9當基準就是最好的方式

2.至於M9的顯示，要與C9 同步同時，還是在流水號有資料輸入後才顯示呢？又是否要依流水號的輸入情況，再依其輸入之值判斷分單號的顯示值呢?
目前我在範例檔案裡的公式是同步同時，只要C9輸入值變更，M9與C11就要同步一起變化，就是依流水號輸入的情況，再依其輸入之值判斷分單號的顯示值

因為自己對於VBA代碼撰寫與應用上不甚了解，也未曾學習過，所以考慮的較欠缺，只能依照自己目前的公式方法作依據來回答您，實在抱歉

菩薩慈悲：終於大抵搞定了。感恩感恩　讚歎讚歎　南無阿彌陀佛
最新程式碼如下：

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Sheet2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Rem 佛弟子文獻學者孫守真任真甫謹製 20230321~24
Const storeCellName As String = "H5"   '店名
Const unitCellName As String = "M5"   '單位
Const itemTypeCellName As String = "C7"   '品項類別
Const itemIDCellName As String = "H7"  '品項代號

Const streamingInputCellName As String = "C9"   '流水號儲存格
Const streamingShowCellName As String = "G9"   '流水號儲存格
'當前無資料可新建",IF(編號產生器!$C$7<>"","當前文件編號已編到"))))
Const streamingShowMsgNotExisted  As String = "當前無資料可新建"   ''流水號不存在訊息
Const streamingShowMsgExisted As String = "當前文件編號已編到"   ''流水號存在訊息
Const streamingShowMsgCellName As String = "D9"   '流水號存在與否訊息儲存格
Const subListCellName As String = "M9"   '分單號儲存格
Const subListVersionCellName As String = "N9"  '分單號當前版本儲存格
Const subListVersionMessage As String = "當前為X版次" 'N9 分單號當前版本儲存格要顯示的文字訊息
Const numberShowCellName As String = "C11"   '訂單編號 to show

Const numberColumn As String = "C"   'Sheets("訂單總表")欄位值


'記下新的編號
Dim newNumberField As String
Private Sub inputNum(Target As Range)
        Dim streamingNum As String
        If Target = "" Then
            Exit Sub
        Else
            streamingNum = Format(Target, "000")
        End If
    
        Dim sublistNumber As String, prefixNum As String
        '取得編號前綴
        prefixNum = getPrefixNum
        '取得含有前綴已編過的流水號與分單號
        Numbers.reset_dictStreamingSublistNumPair
        Numbers.streamingSublist_NumberBuilder ' Target
        If Numbers.dictStreamingSublistNumPair.Exists(streamingNum) Then '如果已有流水號
            '取得新的分單號
            sublistNumber = Numbers.sublistNumber(streamingNum)
        Else '如果尚無流水號
            sublistNumber = "0"
        End If
        '在訂單編號（C11）儲存格顯示
        newNumber = prefixNum + streamingNum & "-" & sublistNumber
        
        '非程式在設定值而是手動輸入時才執行，因為程式在設定值時會觸發此事件
        Application.EnableEvents = False '關閉事件程序
        
        Range(numberShowCellName) = newNumber
        '埴入分單號以顯示在M9
        Range(subListCellName) = sublistNumber
        '設定顯示當前分單號的版次N9
        If sublistNumber = "0" Then
            Range(subListVersionCellName) = VBA.Replace(subListVersionMessage, "X", "初")
        Else
            Range(subListVersionCellName) = VBA.Replace(subListVersionMessage, "X", sublistNumber)
        End If
        
        '恢復事件程序
        Application.EnableEvents = True
End Sub

Private Sub showNum()
    Dim streamingNum As String, sublistNumber As String, prefixNum As String
    '取得既有流水號與分單號
    Numbers.reset_dictStreamingSublistNumPair
    Numbers.streamingSublist_NumberBuilder ' Target
    '取得既有流水號與分單號後
    '取得流水號儲存格
    Dim streamingSublistNumArray
    'streamingNum = Numbers.StreamingNumber
    prefixNum = getPrefixNum()
    '取得同編號前綴最後加入的流水號與分單號，以分別顯示在 G9、M9（及N9）
    streamingSublistNumArray = Numbers.LastStreamingSubstringNumArray(prefixNum)  '(Target, prefixNum)
    streamingNum = streamingSublistNumArray(0) '流水號
    sublistNumber = streamingSublistNumArray(1) '分單號
    
    '非程式在設定值而是手動輸入時才執行，因為程式在設定值時會觸發此事件
    Application.EnableEvents = False '關閉事件程序
'            ThisWorkbook.Unprotect
'            ActiveSheet.Unprotect

    '自動填入流水號以供顯示在G9
    Range(streamingShowCellName) = streamingNum
    '在D9顯示相關訊息
    If streamingSublistNumArray(2) Then
        Range(streamingShowMsgCellName) = streamingShowMsgExisted
    Else
        Range(streamingShowMsgCellName) = streamingShowMsgNotExisted
    End If
    '埴入分單號以顯示在M9
    Range(subListCellName) = sublistNumber
    '設定顯示當前分單號的版次N9
    If sublistNumber = "0" Then
        Range(subListVersionCellName) = VBA.Replace(subListVersionMessage, "X", "初")
    Else
        Range(subListVersionCellName) = VBA.Replace(subListVersionMessage, "X", sublistNumber)
    End If

'            '恢復保護
'            ActiveSheet.Protect
'            ThisWorkbook.Protect

            '恢復事件程序
            Application.EnableEvents = True

End Sub

Public Property Get newNumber() As String
    newNumber = newNumberField
End Property

Public Property Let newNumber(ByVal NewValue As String)
     newNumberField = NewValue
End Property

Public Function getPrefixNum() As String
Dim prefixNum As String, rw As Long
prefixNum = Range(storeCellName) & "-" & Range(unitCellName) & "-" & Range(itemTypeCellName) & "-" & Range(itemIDCellName) & "-"
getPrefixNum = prefixNum
End Function

Rem 以下為原有程式碼，非鄙人之部分以'……略去

Private Sub CommandButton1_Click()
Const fontSize As Single = 16
'……

Numbers.numberDictAppend Range(numberShowCellName), getPrefixNum

'……
CommandButton1.Font.Size = fontSize
End Sub

'……Rem end 以上為原有程式碼


Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo eH
    '使用者輸入流水號（儲存格C9）後
'    If Target.Row = Range(streamingInputCellName).Row And Target.Column = Range(streamingInputCellName).Column Then
    If Not Intersect(Target, Range(streamingInputCellName)) Is Nothing Then
        inputNum Target
    '品項代號輸入完後
    ElseIf Not Intersect(Target, Range(itemIDCellName)) Is Nothing Or Not Intersect(Target, Range(itemTypeCellName)) Is _
            Nothing Or Not Intersect(Target, Range(unitCellName)) Is Nothing Or Not Intersect(Target, Range(storeCellName)) Is Nothing Then
        If Range(storeCellName) <> "" And Range(unitCellName) <> "" And Range(itemTypeCellName) <> "" And Range(itemIDCellName) <> "" Then
                showNum
        End If
    End If
Exit Sub
eH:
Select Case Err.number
    Case 50290 ''Intersect' 方法 ('_Global' 物件) 失敗
    Case Else
        MsgBox Err.number + Err.Description
End Select

End Sub

Attribute VB_Name = "Numbers"
Rem 佛弟子文獻學者孫守真任真甫謹製 20230321~24
Option Explicit
Rem 編號=品項號（編號前綴）+流水號+分單號（分號）
Rem 用 Public 宣告是為了在活頁簿開啟時均能保特有效，隨時可供存取的緣故
' dict 存放已有編號：'鍵值為編號,值為編號前綴
Public dict As New Scripting.Dictionary, dictStreamingSublistNumPair As New Scripting.Dictionary '存放已有流水號與分單號之資料（string 型別），鍵值Key為流水號，值value為分單號（Dictionary 型別）

' （未實作）prefix_streaming_sublistNum 存放現有編號的前綴（品項號）與流水號分單號映射的字典（key=編號前綴；value= dictStreamingSublistNumPair ）
Public prefix_StreamingSublistNum As New Scripting.Dictionary
' prefix_streamingNum 存放流水號之前綴字元（即分單號之編號規則）
Dim prefix_streamingNum

' Sheets("訂單總表")的欄名列數
Const columnRowsCount As Byte = 2
'取得既有編號資料筆數
Public Property Get ExistedNumCount() As Long
'更新 ExistedNumCount 值，以供後來 Get NumberDict() 時比對
ExistedNumCount = ExistedNumColumnRange.Count - columnRowsCount '去掉欄名
End Property

Public Property Get ExistedNumColumnRange() As Range
'取得所有編號記錄作參照基
Set ExistedNumColumnRange = Sheets("訂單總表").UsedRange.Columns("C").Cells

End Property

' 現有編號建置器
Sub numberDictBuilder()
Dim c As Range, xc As String
Dim rng As Range

'取得所有編號記錄作參照基
Set rng = ExistedNumColumnRange
''更新 ExistedNumCount 值，以供後來 Get NumberDict() 時比對
'existedNumCount = rng.Count - columnRowsCount '去掉欄名
For Each c In rng
    If c.Row > columnRowsCount Then '除了欄名列，即編號記錄列
        Rem ！！！注意，編號記錄不能有空值！！！
        If c = "" Then Exit For
        xc = c.Value 'c.Text 用 Text屬性慢很多，用value 就瞬間好了 Bing大菩薩 20230324
        dict(xc) = VBA.Left(xc, VBA.InStrRev(VBA.Left(xc, VBA.InStrRev(xc, "-") - 1), "-")) '鍵值為編號，值為編號前綴
        
        
    End If
Next c
End Sub
' 新增編號時更新現有編號器
Sub numberDictAppend(number As String, prefixNum As String) '(prefixNum As String, streamingNum As String, sublistNum As String)
    dict(number) = prefixNum ' number
End Sub

Rem 取得已有編號記錄，回傳一個字典型別的值
Public Property Get NumberDict() As Dictionary
    If dict.Count = 0 Then numberDictBuilder
    Set NumberDict = dict
End Property

Rem 已存在流水號與分單號清單建立器：取得既有流水號與分單號 例 'A-BOX-SIY-A035-001-A
Sub streamingSublist_NumberBuilder() '(Target As Range)
    Dim dict As Dictionary, key, orderNumberPrefix As String, orderNumberPrefixLen As Byte, numSetArr() As String, sublistNumbers As New Scripting.Dictionary '分單號的字典，作為 dictStreamingSublistNumPair 的值(value)
    
    Set dict = Numbers.NumberDict
    '取得現在輸入的流水號前的品項號
    orderNumberPrefix = Sheet2.getPrefixNum
    '取得現在在輸入的流水號前的品項號的長度，以作為判斷流水號的位置起始處
    orderNumberPrefixLen = VBA.Len(orderNumberPrefix)
    For Each key In dict
        '逐一與已有之編號的流水號作比對
        'If Left(key, orderNumberPrefixLen) = orderNumberPrefix Then '如果既有的編號之品項號與現在輸入的相符合，
        If dict(key) = orderNumberPrefix Then '如果既有的編號之品項號與現在輸入的相符合，
            '就解析出它的流水號和分單號（分號）來，以供記錄。以「-」分割二號開來
            numSetArr = VBA.Split(Mid(key, orderNumberPrefixLen + 1), "-") '取得的值是一個一維陣列，第一個元素即已有的流水號，第二個元素即分單號
            '取得既有流水號與分單號
            If dictStreamingSublistNumPair.Exists(numSetArr(0)) Then '如果流水號存在的話
                Set sublistNumbers = dictStreamingSublistNumPair(numSetArr(0))
                sublistNumbers(numSetArr(1)) = numSetArr(1) '取得既有的分單號，存入sublistNumbers 字典（Dictionary 型別）中
                Set dictStreamingSublistNumPair(numSetArr(0)) = sublistNumbers '儲存既有的分單號
            '如果流水號並不曾存在的話
            Else
                If sublistNumbers.Count > 0 Then Set sublistNumbers = Nothing '清空原有記錄（如果有的話）以備用 ps. 用 removeall 方法可能會影響原來存放的資料，Nothing 則不會
                sublistNumbers.Add numSetArr(1), numSetArr(1)
                Set dictStreamingSublistNumPair(numSetArr(0)) = sublistNumbers
            End If
        End If
    Next key
End Sub
Sub reset_dictStreamingSublistNumPair()
dictStreamingSublistNumPair.RemoveAll
End Sub
Sub Dispose()
dict.RemoveAll
Set dict = Nothing
dictStreamingSublistNumPair.RemoveAll
Set dictStreamingSublistNumPair = Nothing
End Sub

Rem 001~999、A01……
'取得新的流水號
Public Property Get StreamingNumber() As String
    Dim i As Byte, strNumber
    Dim pre, pr, startNum As Byte
    pre = GetPrefix_streamingNum(True)
    For Each pr In pre
        '如果開頭是數字，要連號；即要有00（100、200……），不能從01開始（101、201……
        If VBA.IsNumeric(pr) Then
            If VBA.CByte(pr) > 0 Then
                startNum = 0
            Else '如果是數字且開頭是「0」，才從1 開始（沒有000 號，須從001起編流水號）
                startNum = 1
            End If
        Else '如果字母，則定從01開始（A01、B01……）
            startNum = 1
        End If
        For i = startNum To 99
            strNumber = pr + Format(i, "00")
            If Not dictStreamingSublistNumPair.Exists(strNumber) Then
                dictStreamingSublistNumPair.Add strNumber, New Scripting.Dictionary
                StreamingNumber = strNumber
                Exit Property
            End If
        Next i
    Next pr
    '…… A01 、 B01 ……
End Property

'取得最後加入的流水號與分單號,回傳一個陣列：元素1=流水號；元素2=分單號；元素3=是否已存在(存在=true,不存在而傳回預設起始值=false)
Property Get LastStreamingSubstringNumArray(prefixNum As String) As Variant '(Target As Range, prefixNum As String) As Variant
'If dict.Count = 0 Then
'    numberDictBuilder
''    streamingSublist_NumberBuilder
'End If
    Dim arr(2), dictSublist As Scripting.Dictionary
    
'    streamingSublist_NumberBuilder 'Target
    '如果還沒對應前綴的流水號與分單號
    If dictStreamingSublistNumPair.Count = 0 Then
        '不存在而傳回預設起始值
        arr(0) = "001": arr(1) = "0"
        arr(2) = False
    Else
        arr(0) = dictStreamingSublistNumPair.Keys(dictStreamingSublistNumPair.Count - 1) '流水號
        Set dictSublist = dictStreamingSublistNumPair(arr(0))
        arr(1) = dictSublist.Keys(dictSublist.Count - 1) '分單號
        arr(2) = True
    End If
    LastStreamingSubstringNumArray = arr
End Property

'取得新的分單號。傳入剛輸入的新的流水號引數 StreamingNum
Public Function sublistNumber(streamingNum As String) As String
'例： A-BOX-SIY-A035-001-A

    Dim strSubNumber
    Dim prefixs, ePrefixs
    Dim dict As New Scripting.Dictionary, eCln, flagExisted As Boolean
    '取得流水號之前綴字元（即分單號之編號規則）
    If TypeName(dictStreamingSublistNumPair(streamingNum)) = "Empty" Then
        dict.Add "0", "0"
        strSubNumber = "0" '若還沒有就傳回分單號起始編號 0
        Set dictStreamingSublistNumPair(streamingNum) = dict '將此新的分單號加入到 dictStreamingSublistNumPair 中
        sublistNumber = strSubNumber
        Exit Function
    ElseIf dictStreamingSublistNumPair(streamingNum).Count = 0 Then
        dict.Add "0", "0"
        strSubNumber = "0" '若還沒有就傳回分單號起始編號 0
        Set dictStreamingSublistNumPair(streamingNum) = dict '將此新的分單號加入到 dictStreamingSublistNumPair 中
        sublistNumber = strSubNumber
        Exit Function
    Else '若已有舊的分單號，則找出可以用的作為新分單號
        prefixs = GetPrefix_streamingNum(False)
        For Each ePrefixs In prefixs
            '取得新的分單號
            strSubNumber = ePrefixs
            Set dict = dictStreamingSublistNumPair(streamingNum) '取出既有分單號的字典
            If dict.Exists(strSubNumber) Then flagExisted = True
            If Not flagExisted Then
                '如果既有的分單號還沒有這個值，就回傳它
'                dictStreamingSublistNumPair(streamingNum).Add strSubNumber, strSubNumber
                sublistNumber = strSubNumber
                Exit Function
            End If
            flagExisted = False
        Next ePrefixs
    End If
End Function

'取得流水號之前綴字元（即分單號之編號規則）
Public Property Get GetPrefix_streamingNum(streaming As Boolean) As Variant
If streaming Then
    prefix_streamingNum = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "A", "B", "C", "D", "E", "F", "G", "H", "J", "K", "L", "M", "N", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")
Else
    prefix_streamingNum = Array("0", "A", "B", "C", "D", "E", "F", "G", "H", "J", "K", "L", "M", "N", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")
End If
GetPrefix_streamingNum = prefix_streamingNum
End Property

對的，目前以公式函數的方法就是有作判別，如圖三
公式執行會作判別是否有同樣的流水號，如果有就要+1，不能重號

我的意思是用VBA寫出判斷，
你圖中A總店，box盒，DNS日用品，流水號001
先撇除流水號。
先在流水號表的標題欄位，用迴圈尋找
是否有a-box-dns，有就鎖定該欄位，再循列找出a-box-dns最後一筆是a-box-dns-00?
如果欄位尋找時，找不到就自動新增一欄
然後新增一列a-box-dns-001

BTW你把寫的VBA丟出來看看

如圖，我得意思是說 你應該要創建一個總表。
假設今天你要創建分店e-box-dns-
那你應該先用VBA寫迴圈到這裡判斷，是否第一欄有e-box-dns-
沒有就新增，e-box-dns-然後在該欄底下創建e-box-dns-
001=>回傳；

有就記錄該欄位位置。
再用另一個迴圈判斷該欄最後的數字是多少，該數字+1回傳

目前我是以公式函數去作判別，如圖三
從圖三的表中做完判別後，再將回傳的結果以公式顯示到圖一的流水碼與分單號，目前我表裡的VBA代碼只有按鈕新增與清除表格內容的功能，並沒有作編號判別的功能，因為我本身沒有學過VBA代碼，按鈕的代碼也是從網路上找來的，不是我自己寫的...

圖一 新建編號按鈕的VBA代碼

Private Sub CommandButton1_Click()

If MsgBox("請確認是否要新建?", vbYesNo, "確認視窗") = vbNo Then
Exit Sub
End If

Dim e As Integer, arr, aee
    For e = 2 To 14
    arr = Sheet4.Range("a65536").End(3).Row
   If Sheet4.Cells(e, "a").Value <> "" Then
Sheet4.Cells(arr + 1, "a").Value = 工作表6.Cells(e, "a").Value
Sheet4.Cells(arr + 1, "b").Value = 工作表6.Cells(e, "a").Offset(0, 1).Value
Sheet4.Cells(arr + 1, "c").Value = 工作表6.Cells(e, "a").Offset(0, 2).Value
Sheet4.Cells(arr + 1, "d").Value = 工作表6.Cells(e, "a").Offset(0, 3).Value
Sheet4.Cells(arr + 1, "e").Value = 工作表6.Cells(e, "a").Offset(0, 4).Value
Sheet4.Cells(arr + 1, "f").Value = 工作表6.Cells(e, "a").Offset(0, 5).Value
Sheet4.Cells(arr + 1, "g").Value = 工作表6.Cells(e, "a").Offset(0, 6).Value
Sheet4.Cells(arr + 1, "h").Value = 工作表6.Cells(e, "a").Offset(0, 7).Value
End If
Next e
MsgBox "編號已建檔"
End Sub

圖一 清除表格內容按鈕的VBA代碼

Private Sub CommandButton2_Click()
'Updateby Extendoffice
Dim e As Integer, arr, aee
    For e = 2 To 15
    arr = Sheet2.Range("a65536").End(3).Row
   If Sheet4.Cells(e, "a").Value <> "" Then
Sheet2.Range("H5").ClearContents
Sheet2.Range("M5").ClearContents
Sheet2.Range("C7").ClearContents
Sheet2.Range("H7", "J7").ClearContents
Sheet2.Range("C9").ClearContents
Sheet2.Range("M11", "N11").ClearContents
Sheet2.Range("C13", "G13").ClearContents
Sheet2.Range("J13", "O13").ClearContents
Sheet2.Range("C15", "O15").ClearContents
End If
Next e
MsgBox "表格已清空"
End Sub