1マス１文字の入力支援

先日こちら↓で、Excel 方眼紙の入力支援機能が紹介されていました。

www.excelspeedup.com

私も今までに何度か、「１マス１文字」の帳票に出くわして入力支援機能を盛り込んだことがありましたので、便乗して参考までに紹介します。
例）５桁の数字を入力

１マスずつの入力は面倒なので、マクロを使って一気に入力します。入力には、Inputboxを使用します。

Function GetInputNumber() As Long

    Dim InputNumber As Long
        InputNumber = Application.InputBox("５桁の数字を入力してください", _
                                            Title:="数字入力", _
                                            Type:=1)
        If LenB(StrConv(InputNumber, vbFromUnicode)) >= 6 Then
                MsgBox "５桁以下の数字を入力してください。"
                Exit Function
        ElseIf InputNumber = 0 Then
                MsgBox "キャンセルされました。"
                Exit Function
        End If
        
        GetInputNumber = InputNumber
        
End Function

入力内容の細かいチェックは、今回省略です。

次に入力のタイミングですが、今回は「番号」と書かれたA1セルを選択した際とします。そこで、ワークシートのSelectionChangeイベントを利用して、A1セルが選択されたことを切っ掛けに、入力イベントを発生させます。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Select Case Target(1).Address(0, 0)
        Case "A1"
            Dim i As Long
            Dim InputNumber As Long
                InputNumber = GetInputNumber
                For i = 1 To 5
                    Cells(1, i + 1) = Mid(InputNumber, i, 1)
                Next
    End Select
End Sub

これで一応はできたのですが、頻繁にやってしまうのが、「A1」セルを間違って選択してしまう「事故」です。せっかく入力したのに、やり直しは面倒くさい。
そこで入力済みの値を、初期値としてInputBoxに表示させることにしました。

［標準モジュール］

Function GetInputNumber(Optional DefaultNumber As Long = 0) As Long

    Dim InputNumber As Long
        InputNumber = Application.InputBox("５桁の数字を入力してください", _
                                            Title:="数字入力", _
                                            Default:=DefaultNumber, _
                                            Type:=1)
        ' 入力内容確認。
        If LenB(StrConv(InputNumber, vbFromUnicode)) >= 6 Then
                MsgBox "５桁以下の数字を入力してください。"
                Exit Function
        ElseIf InputNumber = 0 Then
                MsgBox "キャンセルされました。"
                Exit Function
        End If
        
        GetInputNumber = InputNumber
        
End Function

［シートモジュール］※入力値が４桁以下の場合の対応も追加。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Select Case Target(1).Address(0, 0)
        Case "A1"
            Dim i As Long
            Dim DefaultNumber As Long
                ' 入力済み値の取得
                For i = 1 To 5
                    DefaultNumber = DefaultNumber + Cells(1, i + 1) * 10 ^ (5 - i)
                Next
            Dim InputNumber As String
                ' 入力値が４桁以下の場合、あたまに０を追加する。
                InputNumber = CStr(Format(GetInputNumber(DefaultNumber), "00000"))
                For i = 1 To 5
                    Cells(1, i + 1) = Mid(InputNumber, i, 1)
                Next
    End Select
End Sub

これで入力済みの番号が、初期値としてInputBoxに表示されるようになりました。

もし間違えてA1を選択したのなら、そのままEnterキーで抜ければ良い訳です。
その他、入力済みならばイベントを発生させない、という方法もあると思います。

参考まで。