|
チェンジイベントで作ってみました。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim j As Long
'空白の時は、終了
If Target.Value = "" Then Exit Sub
'文字数の判別
If Len(Target.Value) <> 17 Then
MsgBox "17文字にして下さい。"
GoTo エラー
End If
'最後の2文字を判別
If Right(Target.Value, 2) <> "00" Then
MsgBox "16,17桁目は、00 にして下さい。"
GoTo エラー
End If
'1文字目から15文字目を1文字ずつチェック
For j = 1 To 15
'MsgBox Asc(Mid(Target.Value, j, 1))
Select Case j
Case 1 To 3
If Asc(Mid(Target.Value, j, 1)) >= 48 And _
Asc(Mid(Target.Value, j, 1)) <= 57 Or _
Asc(Mid(Target.Value, j, 1)) >= 65 And _
Asc(Mid(Target.Value, j, 1)) <= 90 Or _
Asc(Mid(Target.Value, j, 1)) >= 97 And _
Asc(Mid(Target.Value, j, 1)) <= 122 Then
Else
MsgBox "最初の3桁は半角英数字にして下さい。"
GoTo エラー
End If
Case 4 To 10
If Asc(Mid(Target.Value, j, 1)) >= 48 And _
Asc(Mid(Target.Value, j, 1)) <= 57 Or _
Asc(Mid(Target.Value, j, 1)) >= 65 And _
Asc(Mid(Target.Value, j, 1)) <= 90 Or _
Asc(Mid(Target.Value, j, 1)) >= 97 And _
Asc(Mid(Target.Value, j, 1)) <= 122 Or _
Asc(Mid(Target.Value, j, 1)) = 32 Then
Else
MsgBox "4〜10桁目は半角英数字又は半角スペースにして下さい。"
GoTo エラー
End If
Case 11
If Asc(Mid(Target.Value, j, 1)) >= 177 And _
Asc(Mid(Target.Value, j, 1)) <= 221 Or _
Asc(Mid(Target.Value, j, 1)) >= 65 And _
Asc(Mid(Target.Value, j, 1)) <= 90 Then
Else
MsgBox "11桁目は半角カナ又は半角英大文字(A〜Z)にして下さい。 "
GoTo エラー
End If
Case 12 To 15
If Asc(Mid(Target.Value, j, 1)) >= 48 And _
Asc(Mid(Target.Value, j, 1)) <= 57 Then
Else
MsgBox "12〜15桁目は半角数字にして下さい。 "
GoTo エラー
End If
End Select
Next j
Exit Sub '終了
'エラー処理
エラー:
Target.Value = ""
Target.Select
End Sub
|
|