1桁のみを受け入れる（Microsoft Excel）

Private Sub Worksheet_Change(ByVal Target As Range)

If IsNumeric(Target.Value) Then         CRow = Target.Row         CColumn = Target.Column - 1         Entry = Target.Value         For i = 1 To Len(Entry)

Cells(CRow, CColumn + i).Value = Mid(Entry, i, 1)

Next     End If End Sub

Sub Assigns()

Dim i As Variant     With Application         For i = 0 To 9             .OnKey i, "dig" & i         Next     End With End Sub

Sub ClearAssigns()

Dim i As Variant     With Application         For i = 0 To 9             .OnKey i         Next     End With End Sub

Sub dig0()

ActiveCell.Value = 0     ActiveCell.Offset(1, 0).Select End Sub

Sub dig1()

ActiveCell.Value = 1     ActiveCell.Offset(1, 0).Select End Sub

Sub dig2()

ActiveCell.Value = 2     ActiveCell.Offset(1, 0).Select End Sub

Sub dig3()

ActiveCell.Value = 3     ActiveCell.Offset(1, 0).Select End Sub

Sub dig4()

ActiveCell.Value = 4     ActiveCell.Offset(1, 0).Select End Sub

Sub dig5()

ActiveCell.Value = 5     ActiveCell.Offset(1, 0).Select End Sub

Sub dig6()

ActiveCell.Value = 6     ActiveCell.Offset(1, 0).Select End Sub

Sub dig7()

ActiveCell.Value = 7     ActiveCell.Offset(1, 0).Select End Sub

Sub dig8()

ActiveCell.Value = 8     ActiveCell.Offset(1, 0).Select End Sub

Sub dig9()

ActiveCell.Value = 9     ActiveCell.Offset(1, 0).Select End Sub