Option Explicit
 
Public Sub 段落番号付加()
    Dim ws As Worksheet         '段落番号付加対象ワークシート
    Dim wrow As Long            '作業用行番号
    Dim maxrow As Long          '段落番号付加対象となる最大行番号
    Dim LVNO(1 To 5) As Long    'レベル毎の段落番号テーブル（レベル1:C列～レベル5:G列）
    Dim lv As Long              'レベル番号（作業用）
    Dim lvstr As String         '段落番号
    Set ws = ActiveSheet        'アクティブシートを段落番号付加対象とする
    maxrow = 0
    'C列を12行～終端まで繰り返す
    For wrow = 12 To Rows.Count
        '当該行のセルが、結合セルでないなら繰り返し終了
        If ws.Cells(wrow, "C").MergeCells = False Then Exit For
        '当該行番号を記憶する
        maxrow = wrow
    Next
    '結合セルがない場合は、終了する
    If maxrow = 0 Then
        MsgBox ("段落不正")
        Exit Sub
    End If
    '段落番号テーブル初期化
    Call init_lvno(1, LVNO)
    '12行～結合セル最大行まで繰り返す
    For wrow = 12 To maxrow
        'レベル1～レベル最大まで繰り返す
        For lv = 1 To UBound(LVNO)
            '該当セルに文字が記入されている場合
            If ws.Cells(wrow, 2 + lv) <> "" Then
                '該当セルに対応する段落番号を取得する
                lvstr = set_lvno(lv, LVNO)
                '取得した段落番号をB列に設定する
                ws.Cells(wrow, "B").Value = lvstr
                Exit For
            End If
        Next
    Next
End Sub
'段落番号取得
'lv:レベル番号
'LVNO():段落番号テーブル
Private Function set_lvno(ByVal lv As Long, ByRef LVNO() As Long) As String
    Dim wstr As String: wstr = ""
    Dim i As Long
    '指定レベルの番号に1加算する
    LVNO(lv) = LVNO(lv) + 1
    '指定レベルの次のレベル以降を0クリアする
    Call init_lvno(lv + 1, LVNO)
    '段落番号を文字にする
    For i = 1 To UBound(LVNO)
        '番号が0の場合、終了する
        If LVNO(i) = 0 Then Exit For
        '最初以外は．をつける
        If wstr <> "" Then wstr = wstr & "."
        '番号を連結する
        wstr = wstr & LVNO(i)
    Next
    set_lvno = wstr
End Function
'段落番号テーブル初期化
'lv:初期化を行うレベル番号
'LVNO():段落番号テーブル
Private Sub init_lvno(ByVal lv As Long, ByRef LVNO() As Long)
    Dim i As Long
    '指定レベル番号以降を0でクリアする
    For i = lv To UBound(LVNO)
        LVNO(i) = 0
    Next
End Sub
 

T3B0aW9uIEV4cGxpY2l0CgpQdWJsaWMgU3ViIOauteiQveeVquWPt+S7mOWKoCgpCiAgICBEaW0gd3MgQXMgV29ya3NoZWV0ICAgICAgICAgJ+auteiQveeVquWPt+S7mOWKoOWvvuixoeODr+ODvOOCr+OCt+ODvOODiAogICAgRGltIHdyb3cgQXMgTG9uZyAgICAgICAgICAgICfkvZzmpa3nlKjooYznlarlj7cKICAgIERpbSBtYXhyb3cgQXMgTG9uZyAgICAgICAgICAn5q616JC955Wq5Y+35LuY5Yqg5a++6LGh44Go44Gq44KL5pyA5aSn6KGM55Wq5Y+3CiAgICBEaW0gTFZOTygxIFRvIDUpIEFzIExvbmcgICAgJ+ODrOODmeODq+avjuOBruauteiQveeVquWPt+ODhuODvOODluODq++8iOODrOODmeODqzE6Q+WIl++9nuODrOODmeODqzU6R+WIl++8iQogICAgRGltIGx2IEFzIExvbmcgICAgICAgICAgICAgICfjg6zjg5njg6vnlarlj7fvvIjkvZzmpa3nlKjvvIkKICAgIERpbSBsdnN0ciBBcyBTdHJpbmcgICAgICAgICAn5q616JC955Wq5Y+3CiAgICBTZXQgd3MgPSBBY3RpdmVTaGVldCAgICAgICAgJ+OCouOCr+ODhuOCo+ODluOCt+ODvOODiOOCkuauteiQveeVquWPt+S7mOWKoOWvvuixoeOBqOOBmeOCiwogICAgbWF4cm93ID0gMAogICAgJ0PliJfjgpIxMuihjO+9nue1guerr+OBvuOBp+e5sOOCiui/lOOBmQogICAgRm9yIHdyb3cgPSAxMiBUbyBSb3dzLkNvdW50CiAgICAgICAgJ+W9k+ipsuihjOOBruOCu+ODq+OBjOOAgee1kOWQiOOCu+ODq+OBp+OBquOBhOOBquOCiee5sOOCiui/lOOBl+e1guS6hgogICAgICAgIElmIHdzLkNlbGxzKHdyb3csICJDIikuTWVyZ2VDZWxscyA9IEZhbHNlIFRoZW4gRXhpdCBGb3IKICAgICAgICAn5b2T6Kmy6KGM55Wq5Y+344KS6KiY5oa244GZ44KLCiAgICAgICAgbWF4cm93ID0gd3JvdwogICAgTmV4dAogICAgJ+e1kOWQiOOCu+ODq+OBjOOBquOBhOWgtOWQiOOBr+OAgee1guS6huOBmeOCiwogICAgSWYgbWF4cm93ID0gMCBUaGVuCiAgICAgICAgTXNnQm94ICgi5q616JC95LiN5q2jIikKICAgICAgICBFeGl0IFN1YgogICAgRW5kIElmCiAgICAn5q616JC955Wq5Y+344OG44O844OW44Or5Yid5pyf5YyWCiAgICBDYWxsIGluaXRfbHZubygxLCBMVk5PKQogICAgJzEy6KGM772e57WQ5ZCI44K744Or5pyA5aSn6KGM44G+44Gn57mw44KK6L+U44GZCiAgICBGb3Igd3JvdyA9IDEyIFRvIG1heHJvdwogICAgICAgICfjg6zjg5njg6sx772e44Os44OZ44Or5pyA5aSn44G+44Gn57mw44KK6L+U44GZCiAgICAgICAgRm9yIGx2ID0gMSBUbyBVQm91bmQoTFZOTykKICAgICAgICAgICAgJ+ipsuW9k+OCu+ODq+OBq+aWh+Wtl+OBjOiomOWFpeOBleOCjOOBpuOBhOOCi+WgtOWQiAogICAgICAgICAgICBJZiB3cy5DZWxscyh3cm93LCAyICsgbHYpIDw+ICIiIFRoZW4KICAgICAgICAgICAgICAgICfoqbLlvZPjgrvjg6vjgavlr77lv5zjgZnjgovmrrXokL3nlarlj7fjgpLlj5blvpfjgZnjgosKICAgICAgICAgICAgICAgIGx2c3RyID0gc2V0X2x2bm8obHYsIExWTk8pCiAgICAgICAgICAgICAgICAn5Y+W5b6X44GX44Gf5q616JC955Wq5Y+344KSQuWIl+OBq+ioreWumuOBmeOCiwogICAgICAgICAgICAgICAgd3MuQ2VsbHMod3JvdywgIkIiKS5WYWx1ZSA9IGx2c3RyCiAgICAgICAgICAgICAgICBFeGl0IEZvcgogICAgICAgICAgICBFbmQgSWYKICAgICAgICBOZXh0CiAgICBOZXh0CkVuZCBTdWIKJ+auteiQveeVquWPt+WPluW+lwonbHY644Os44OZ44Or55Wq5Y+3CidMVk5PKCk65q616JC955Wq5Y+344OG44O844OW44OrClByaXZhdGUgRnVuY3Rpb24gc2V0X2x2bm8oQnlWYWwgbHYgQXMgTG9uZywgQnlSZWYgTFZOTygpIEFzIExvbmcpIEFzIFN0cmluZwogICAgRGltIHdzdHIgQXMgU3RyaW5nOiB3c3RyID0gIiIKICAgIERpbSBpIEFzIExvbmcKICAgICfmjIflrprjg6zjg5njg6vjga7nlarlj7fjgasx5Yqg566X44GZ44KLCiAgICBMVk5PKGx2KSA9IExWTk8obHYpICsgMQogICAgJ+aMh+WumuODrOODmeODq+OBruasoeOBruODrOODmeODq+S7pemZjeOCkjDjgq/jg6rjgqLjgZnjgosKICAgIENhbGwgaW5pdF9sdm5vKGx2ICsgMSwgTFZOTykKICAgICfmrrXokL3nlarlj7fjgpLmloflrZfjgavjgZnjgosKICAgIEZvciBpID0gMSBUbyBVQm91bmQoTFZOTykKICAgICAgICAn55Wq5Y+344GMMOOBruWgtOWQiOOAgee1guS6huOBmeOCiwogICAgICAgIElmIExWTk8oaSkgPSAwIFRoZW4gRXhpdCBGb3IKICAgICAgICAn5pyA5Yid5Lul5aSW44Gv77yO44KS44Gk44GR44KLCiAgICAgICAgSWYgd3N0ciA8PiAiIiBUaGVuIHdzdHIgPSB3c3RyICYgIi4iCiAgICAgICAgJ+eVquWPt+OCkumAo+e1kOOBmeOCiwogICAgICAgIHdzdHIgPSB3c3RyICYgTFZOTyhpKQogICAgTmV4dAogICAgc2V0X2x2bm8gPSB3c3RyCkVuZCBGdW5jdGlvbgon5q616JC955Wq5Y+344OG44O844OW44Or5Yid5pyf5YyWCidsdjrliJ3mnJ/ljJbjgpLooYzjgYbjg6zjg5njg6vnlarlj7cKJ0xWTk8oKTrmrrXokL3nlarlj7fjg4bjg7zjg5bjg6sKUHJpdmF0ZSBTdWIgaW5pdF9sdm5vKEJ5VmFsIGx2IEFzIExvbmcsIEJ5UmVmIExWTk8oKSBBcyBMb25nKQogICAgRGltIGkgQXMgTG9uZwogICAgJ+aMh+WumuODrOODmeODq+eVquWPt+S7pemZjeOCkjDjgafjgq/jg6rjgqLjgZnjgosKICAgIEZvciBpID0gbHYgVG8gVUJvdW5kKExWTk8pCiAgICAgICAgTFZOTyhpKSA9IDAKICAgIE5leHQKRW5kIFN1Ygo=