【ExcelVBA】選択セル範囲に丸数字を連番で入力するマクロ

選択したセル範囲に、丸数字を連番で入力するマクロを紹介します。

実行型の便利マクロですので、
Excel起動時に裏で開かれる「個人用マクロブック」などに搭載して使ってください。

頻繁に使うなら、ショートカットキーやツールバーの登録も便利です。

選択セルに丸数字を連番で入力するマクロ
選択テキストの頭に丸数字を接頭するマクロ

選択セルに丸数字を連番で入力するマクロ

実行・活用例

タイトルの通りですが、セル範囲を選択した状態で実行すると、
↓のように各セルに丸数字を入力します。

丸数字出力のサンプル

ソースコード

' 実行マクロ本体
Sub 選択セルに丸数字を連番で出力する()
    Dim i As Long: i = 1
    Dim セル As Range
    For Each セル In Selection
        セル.Value = 丸数字(i)
        i = i + 1
    Next
End Sub

' 「0～50」を「⓪～㊿」に変換する関数（読み飛ばしてOK）
Function 丸数字(ByVal n As Long) As String
    Select Case n
    Case 1 To 20
        丸数字 = Chr(Asc("①") + n - 1)
    Case 21 To 35
        丸数字 = ChrW(12881 + n - 21)
    Case 36 To 50
        丸数字 = ChrW(12977 + n - 36)
    Case 0
        丸数字 = ChrW(9450)
    Case Else
        丸数字 = "(" & n & ")"
    End Select
End Function

コードの解説

まずは上の本体マクロですが、丸数字の変換を関数に隔離したので、超単純ですね。

Selectionを1セルずつループして、ループカウンタの丸数字を入力しているだけです。

隔離した「丸数字(i)」という関数は、↓の仕様の関数です。

丸数字(1) ' = ①
丸数字(24) ' = ㉔

今回のメインテーマでないため、解説は省きます。
解説が読みたい方は数値を丸数字①②③～に変換するへそうぞ。

こういう「複雑だけど、できてしまえば読む必要のないコード」をメインコードに直に打ち込むと、本当に大事な処理が埋もれてしまって見えなくなります。

関数の中に隠してしまえば、メインコードがすっきり読みやすくなるので、積極的に関数に隠しましょう。

関数を「何回も出てくるコードをまとめるもの」と思っている方は、それよりも
「臭いものに蓋をして、本当の目的を処理するコードを読みやすくするもの」
と考えた方が、関数分けのコツがつかめるかもしれません。

選択テキストの頭に丸数字を接頭するマクロ

皆さんはどんな目的でこのページに来ましたか？

もし「テキストに付番する」目的であった場合は、
こちらのマクロの方が便利かもしれません。

実行・活用例

丸番号のテキスト接頭サンプル

セルにすでにあるテキストの、頭に丸数字を接頭するマクロです。

ソースコード

Sub 選択セルのテキストに丸数字を接頭する()

    Dim i As Long: i = 1
    Dim セル As Range
    For Each セル In Selection
    
        If セル.Value = "" Then
            セル.Value = 丸数字(i)
        Else
            セル.Value = 丸数字(i) & " " & セル.Value
        End If
        
        i = i + 1
    Next

End Sub

コードの解説

「既にあるテキストの頭に丸数字をつける」を、

セル.Value = 丸数字(i) & " " & セル.Value

で実装しています。そのまんまですね。

Ifの分岐で、空白セルに対してはただの入力にしています。

つまり、空白セル範囲に実行すれば、第1のマクロとまったく同じ処理になります。

開始番号を選べるようにするカスタマイズ

Dim i As Long: i = 1

この部分を、

Dim i As Variant
i = InputBox("開始する番号を入力してください。(省略時は1からスタートします)")
If i = "" Then i = 1

If IsNumeric(i) = False Then
    MsgBox ("開始番号は数値で入力してください。")
    Exit Sub
End If

このようにに変えると、スタートを①以外にも指定できるようになります。
指定しなかった場合は、①から出力されます。

番号を振りなおせるようにするカスタマイズ

すでについてる番号を消すための

Sub 選択したセルのテキスト左側部分を削除する()

    Dim 削除文字数 As Variant
    削除文字数 = InputBox("削除する文字数を入力してください。")
    
    If IsNumeric(削除文字数) = False Then
        MsgBox ("削除文字数は数値で入力してください。")
        Exit Sub
    End If
    
    Dim セル As Range
    For Each セル In Selection
        セル.Value = Mid(セル.Value, 削除文字数 + 1)
    Next
    
End Sub