カウントアップ後の番号を自動取得

先日、こちらの記事を拝読した。
koroko.hatenablog.com

これは懐かしい。なぜなら、私も以前に似たような状況で、似たようなツールを作成して使用していたから。
今では異動して使わなくなったそれを、思い出しながら再作成してみた。

もはや詳細は、忘却の彼方。覚えている中から必要部分だけを抜き出すと、帳票のレイアウトはこのような感じだ。

商品別に、アルファベット二文字が頭につき、その後に３桁の通し番号が続く。

これを、Worksheet のChangeイベントで作成したのがこちら。

シートモジュール

Enum 処理列
    受付日 = 1
    受付番号
    内容
End Enum

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 単一セルのときのみ処理する。
    If Target.Count > 1 Then
        Exit Sub
    End If
    
    Select Case Target.Column
        Case 処理列.受付番号
            Application.ScreenUpdating = False
            ' 無限ループ回避のため。
            Application.EnableEvents = False
            Select Case Target.Value
                ' 受付番号が削除された場合。
                Case vbNullString
                    Cells(Target.Row, 1) = vbNullString
                Case Else
                    Target.Value = GetNextNumber(Target)
                    Cells(Target.Row, 1) = Date
            End Select
            Application.ScreenUpdating = True
            Application.EnableEvents = True
    End Select
End Sub

Function GetNextNumber(target_range As Range) As String
    ' 引数が英字二文字（例.AB）の場合、
    ' その最大値を探し（例.AB005）、
    ' カウントアップしたものを返す（例.AB006）。
    Dim FindCode As String
        FindCode = StrConv(target_range.Value, vbNarrow + vbUpperCase)
        
    Dim myReg As RegExp
    Set myReg = New RegExp
        myReg.Pattern = "^[A-Z]{2}$"
        If myReg.test(FindCode) = False Then
            GetNextNumber = "入力値エラー：アルファベット２文字を入力ください。"
            Exit Function
        End If
        
    Dim FindResult As Range
    Set FindResult = Columns(target_range.Column).Find(What:=FindCode, _
                                                       LookAt:=xlPart, _
                                                       After:=target_range, _
                                                       SearchDirection:=xlPrevious)
        If FindResult.Address = target_range.Address Then
            GetNextNumber = FindCode & "001"
        Else
            GetNextNumber = FindCode & Format(CLng(Right(FindResult, 3)) + 1, "000")
        End If
End Function

結果は、↓ こちら。

参考まで。