VBAで①②③、ABCなどの連続番号を入力する（オートフィル風）

こんにちは。
派犬事務員のコロ子です。

①②③やABCのオートフィル風を作る

先日、「①②③とかABCとかをオートフィルできる方法ないんですか？」と質問を受けた。
どうやらないっぽい。関数とかで作れるみたいだけど、毎回関数を入れるのも面倒なのでVBAで作ってみよう。

Asc関数

「Asc関数」の戻り値は「Shift_JIS の文字コード」を利用して作成してみよう。
まずはShift_JIS の文字コードを確認してみる。

右下のタスクバーの文字を右クリックして「IMEパッド」を開く

IMEパッドの左側から「シフトJIS」を選択する。

半角英数、記号などフォルダがいっぱいある。半角英数から英文字を探してみると、「ABC・・・Z」は連続した文字コードになっている。①～⑳も連続した文字コードになっている。ということは、ループで作れる！

オートフィル風は
①まず先頭に文字を入力する。
②連続文字を入力する範囲を選択する。
③選択した範囲に連続した文字が入るようにする。

上記のコードを作成する。

Sub 選択範囲を連続番号にする()

    Dim ran As Range
    Dim buf As Long

    For Each ran In Selection

        '先頭のセルの場合
        If ran = Selection(1) Then

            'Acsコードに変換
            buf = Asc(ran.Value)

        Else

            '文字コードに戻す
            buf = buf + 1
            ran = Chr(buf)

        End If

    Next ran

End Sub

コードができたら、どのExcelでも使えるように個人用マクロブックの「PERSONAL.XLSB」に登録する。

個人用マクロブックの作り方は↓の真ん中あたりを参考にして
https://koroko.hatenablog.com/entry/2019/09/10/211811

さらにクイックアクセスツールバーにマクロを登録する。
①ファイル→オプションより「クイックアクセスツールバー」を選択する
②マクロを選択する
③「選択範囲を連続番号にする」マクロを選択する
④追加をクリックする
⑤追加した「選択範囲を連続番号にする」マクロを選択する
⑥「変更」をクリックして好きなアイコンを選択する。
⑦「OK」をクリックする

オートフィル風の出来上がり！

もちろん、横方向にも、飛び飛びでもできるよ。

「あいうえお」の場合は「ぁあぃい、かが」など並び順が不規則なので注意！
また普通の数字もできないです。
その場合はこちらを参考に。

Sub 選択範囲を連続番号にする()

    Dim ran As Range
    Dim buf As Long

    '数字の場合
    If IsNumeric(Selection(1).Value) Then

        For Each ran In Selection

            If ran = Selection(1) Then

                buf = ran.Value

            Else

                buf = buf + 1
                ran = buf

            End If

        Next ran

    '日付の場合
    ElseIf IsDate(Selection(1).Value) Then

        Dim mydate As Date

        For Each ran In Selection

            If ran = Selection(1) Then

                mydate = ran.Value

            Else


                mydate = mydate + 1
                ran = mydate


            End If

        Next ran


    '「あいうえお」の場合（ぁあぃい、かが、など並び順が不規則なので）
    ElseIf InStr("あいうえおかきくけこさしすせそたちつてとなにぬねのはひふへほまみむめもやゆよらりるれろわをん", Selection(1).Value) Then

        Dim i As Long
        For Each ran In Selection

            If ran = Selection(1) Then

                'Acsコードに変換
                buf = Asc(ran.Value) + 1

            Else

                Do

                    If InStr("あいうえおかきくけこさしすせそたちつてとなにぬねのはひふへほまみむめもやゆよらりるれろわをん", Chr(buf)) Then

                        ran = Chr(buf)
                        buf = buf + 1
                        Exit Do

                    Else

                        buf = buf + 1

                    End If

                Loop

            End If

        Next ran

    '他（①とかAとか）
    Else

        For Each ran In Selection

            If ran = Selection(1) Then

                'Acsコードに変換
                buf = Asc(ran.Value)

            Else

                '文字コードに戻す
                buf = buf + 1
                ran = Chr(buf)

            End If

        Next ran

    End If

End Sub