選択範囲に連番を振る

選択範囲に連番を振ります。
最初のセルが空白なら1から、値が入ってるときはその値から連番になります。

PERSONAL.XLSBにいれておいて、「リボンのカスタマイズ」でリボンに表示しておくと便利で、一番使ってるかもと思うくらい使ってます。

Sub 連番()

    Dim MsgRtn As Long              'メッセージボックスの返り値
    Dim i As Long
    Dim c As Variant
    
    '開始メッセージ
    MsgRtn = MsgBox("選択されているセル範囲に連番を付与します。" & vbCrLf & vbCrLf & _
                    "※開始セルに数値が入っていればその値からの連番になります。" & vbCrLf _
                    , vbYesNo + vbInformation)
    If MsgRtn <> vbYes Then Exit Sub
    '初期値設定
    Set c = Selection.Item(1)
    If c <> &quot;&quot; And IsNumeric(c) = True Then
        '最初のセルに数値が入っていればその数値から
        i = c
    Else
        '最初のセルに数値が入っていなければ1から
        i = 1
    End If
    '連番
    For Each c In Selection
        c.Value = i
        i = i + 1
    Next c
    Set c = Nothing
    '終了メッセージ
    MsgRtn = MsgBox(&quot;終わり。&quot; & vbCrLf _
                    , vbYesNo + vbInformation)

End Sub
タイトルとURLをコピーしました