|
完成した物(INAさん含め色々な方にお手伝いをしてもらい完成したもの)・・・・ですが、何かここがおかしいと思ったら指摘してください。
どうもありがとうございました!!
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim C As Range
Dim i As Long
Dim strTest As String
ActiveSheet.Columns("A:AZ").NumberFormatLocal = "@"
With Selection
.HorizontalAlignment = xlGeneral
End With
strTest = Target.Value
If Len(strTest) = LenB(StrConv(strTest, vbFromUnicode)) Then
Else
Target.Value = ""
MsgBox "全角は入力できません"
End If
'列Bのみ対象
If Target.Column = 2 Then
Application.EnableEvents = True
If Target.Column <> 2 Then Exit Sub
Application.EnableEvents = False 'イベント発生停止
'文字数
If Len(Target.Value) <> 7 Then
MsgBox "7文字入力して下さい。"
GoTo 終了
End If
For Each C In Target
C.Value = StrConv(C.Value, 9)
Next
Application.EnableEvents = True
Exit Sub
End If
'列Cのみ対象
If Target.Column = 3 Then
Application.EnableEvents = True
If Target.Column <> 3 Then Exit Sub
Application.EnableEvents = False 'イベント発生停止
'文字数
If Len(Target.Value) <> 3 Then
MsgBox "3文字入力して下さい。"
GoTo 終了
End If
For Each C In Target
C.Value = StrConv(C.Value, 9)
Next
Application.EnableEvents = True
Exit Sub
End If
'列Eのみ対象
If Target.Column = 5 Then
Application.EnableEvents = True
If Target.Column <> 5 Then Exit Sub
Application.EnableEvents = False 'イベント発生停止
'文字数
If Len(Target.Value) <> 3 Then
MsgBox "3文字入力して下さい。"
GoTo 終了
End If
For Each C In Target
C.Value = StrConv(C.Value, 9)
Next
Application.EnableEvents = True
Exit Sub
End If
'列Dのみ対象
If Target.Column = 4 Then
Application.EnableEvents = True
If Target.Column <> 4 Then Exit Sub
Application.EnableEvents = False 'イベント発生停止
'文字数
If Len(Target.Value) <> 6 Then
MsgBox "6文字入力して下さい。"
GoTo 終了
End If
For Each C In Target
Next
'1文字ずつASCIコードでチェック
For i = 1 To 6
If Asc(Mid(Target.Value, i, 1)) >= 48 And _
Asc(Mid(Target.Value, i, 1)) <= 57 Then
Else
MsgBox "0〜9 以外の文字が入力されています。"
GoTo 終了
End If
Next i
Application.EnableEvents = True
Exit Sub
終了:
Target.Value = ""
Target.Select
Application.EnableEvents = True
End If
End Sub
|
|