エクセルに書かれた項番をずらすマクロ メモ

Sub ShiftNumbersWithInput()
Dim ws As Worksheet
Dim rng As Range
Dim cell As Range
Dim startNum As Long
Dim str As String, num As Long
Dim parts() As String
Dim inputVal As String

' ユーザーに番号の入力を求める
inputVal = InputBox("どの番号からずらしますか？", "番号指定", "3")
If inputVal = "" Then Exit Sub ' キャンセルされた場合は終了
If Not IsNumeric(inputVal) Then
    MsgBox "数値を入力してください。", vbExclamation
    Exit Sub
End If

startNum = Val(inputVal)

' 対象となるワークシートと列を設定
Set ws = ThisWorkbook.Sheets("Sheet1") ' シート名を適宜変更してください
Set rng = ws.Range("A1:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)

For Each cell In rng
    str = cell.Value
    ' 空白でないセルのみ処理
    If str <> "" Then
        ' ピリオドで区切られた数字を見つける
        parts = Split(str, ".")
        If UBound(parts) >= 0 Then
            If IsNumeric(parts(0)) Then
                num = Val(parts(0))
                ' 指定された番号以上の場合、1増加
                If num >= startNum Then
                    num = num + 1
                    parts(0) = CStr(num)
                    ' 更新された番号で文字列を再構築
                    cell.Value = Join(parts, ".")
                End If
            End If
        End If
    End If
Next cell

MsgBox "処理が完了しました。", vbInformation

End Sub