【VBA】枝番を振る

階層がある項目に枝番をふります。
エラーチェックは入れていないので、
枝番をふられる対象の項目が、
ちゃんと書かれていることが前提。

枝番の階層を変更したいときは、
ワークシートの列を増減させて、
LEVEL_NUMに何階層まであるか、
eCOLに追加した列の分のを足してください。
Enumで全列定義しているのは、
わたしが枝番をふる以外のこともしたいからです。

Option Explicit

'---------------------------------------------------------------------------------------------------
' 定義
'---------------------------------------------------------------------------------------------------
Const DATA_START_ROW As Integer = 4    'データ開始行
Const LEVEL_NUM As Integer = 3         'レベルの階層

Private Enum eCOL    '列インデックス
    Level1 = 1
    Level2
    Level3
'    Level4
    項目Lv1
    項目Lv2
    項目Lv3
'    項目Lv4
    TRAILER
End Enum

'---------------------------------------------------------------------------------------------------
'【処 理 名】採番処理
'【処理概要】記述されている階層に応じて枝番をふる
'【引    数】なし
'【返 却 値】なし
'---------------------------------------------------------------------------------------------------
Public Sub 採番()
    Dim sh As Worksheet                        'ワークシートオブジェクト
    Dim items() As Variant                     'ワークシートデータ格納領域
    Dim serialNumber(LEVEL_NUM - 1) As Variant '採番作業領域
    Dim endRowIndex As Long                    'ワークシート末尾行
    Dim rowIndex As Long                       '行インデックス
    
    'ワークシートオブジェクト取得
    Set sh = ThisWorkbook.Worksheets("Sheet1")
    '末尾行取得
    endRowIndex = getEndRow(sh)
    For rowIndex = DATA_START_ROW To endRowIndex
        '配列に格納
        items = sh.Range(sh.Cells(rowIndex, eCOL.項目Lv1), _
                sh.Cells(rowIndex, eCOL.項目Lv1 + LEVEL_NUM - 1))
        '枝番配列生成
        Call createLevelArray(items, serialNumber)
        'ワークシートへ書き込み
        sh.Range(sh.Cells(rowIndex, eCOL.Level1), _
            sh.Cells(rowIndex, eCOL.Level1 + LEVEL_NUM - 1)) = serialNumber
    Next
    
    Set sh = Nothing
End Sub

'---------------------------------------------------------------------------------------------------
'【処 理 名】末尾行取得
'【処理概要】項目レベル11～項目レベル13の中で、最大の末尾行を取得する
'【引    数】[I]ByVal sh As Worksheet    ワークシートオブジェクト
'【返 却 値】末尾行数
'---------------------------------------------------------------------------------------------------
Private Function getEndRow(ByVal sh As Worksheet) As Long
    Dim endRowIndex As Long    '末尾行数取得領域
    Dim colIndex As Long       '列インデックス
    
    getEndRow = 0
    For colIndex = eCOL.項目Lv1 To eCOL.TRAILER - 1
        '末尾行取得
        endRowIndex = sh.Cells(Rows.Count, colIndex).End(xlUp).Row
        '今まで取得した末尾行より大きい場合は、その値を取得する
        If getEndRow < endRowIndex Then
            getEndRow = endRowIndex
        End If
    Next
End Function

'---------------------------------------------------------------------------------------------------
'【処 理 名】レベル取得
'【処理概要】何階層まで記載されているかを取得する
'【引    数】[I]items() As Variant    ワークシートの項目を格納した配列
'【返 却 値】レベル
'---------------------------------------------------------------------------------------------------
Private Function getLevel(items() As Variant) As Integer
    Dim index As Integer    '列インデックス
    
    getLevel = LEVEL_NUM
    '配列の要素数
    For index = 1 To LEVEL_NUM - 1
        'どこまで記載があるかで枝番のレベルを判定する
        If items(1, index) <> "" Then
            getLevel = index
            Exit Function
        End If
    Next index
End Function

'---------------------------------------------------------------------------------------------------
'【処 理 名】採番情報生成
'【処理概要】ワークシートに書き込むための採番情報を配列に格納する
'【引    数】[I]ByVal level As Integer               階層
'            [I/O]ByRef serialNumber() As Variant    採番情報格納配列
'【返 却 値】なし
'---------------------------------------------------------------------------------------------------
Private Sub createLevelArray(items() As Variant, ByRef serialNumber() As Variant)
    Dim level As Integer     '階層
    Dim branch As Integer    '現在の番号

    'レベル取得
    level = getLevel(items)
    '該当レベルの次の番号を取得する
    branch = IIf(serialNumber(level - 1) = "", 0, serialNumber(level - 1)) + 1
    '該当レベルより下の枝番はクリアする
    Call clearSerialNumberBranch(serialNumber, level)
    '該当レベルの番号を設定する
    serialNumber(level - 1) = branch
End Sub

'---------------------------------------------------------------------------------------------------
'【処 理 名】枝番クリア
'【処理概要】該当レベルより下の枝番はクリアする
'【引    数】[I/O]ByRef serialNumber() As Variant    採番情報格納配列
'            [I]ByVal level As Integer               階層
'【返 却 値】なし
'---------------------------------------------------------------------------------------------------
Private Sub clearSerialNumberBranch(ByRef serialNumber() As Variant, ByVal level As Integer)
    Dim index As Integer     '配列要素インデックス
    
    For index = level To UBound(serialNumber)
        serialNumber(index) = ""
    Next
End Sub