特定のセルの文字入力を半角英字の大文字にする方法

質問

セルＢ１３～ＢＫ１３に文字を入力する際に、全角小文字の英字や数字、半角小文字の英字や数字、全角大文字の英字や数字で入力した場合でも、自動で半角大文字の英字と数字に自動変換して、英字と数字の間に半角で１角の空欄を自動でしてくれる様にするＶＢＡなどの方法はありますか？

この際にどの様な形式の平仮名やカタカナや‐（ハイフン）が入力された場合は「平仮名やカタカナや‐は入力できません。」とエラーメッセージを表示させたいです。

※例えば「ggg 501（半角小文字の英字）」や「ｇｇｇ ５０１（全角小文字の英字）」や「ＧＧＧ ５０１（全角大文字の英字）」と入力した場合でも自動で「GGG 501（半角大文字の英字）」と自動変換され英字と数字の間に１角の半角で空白が自動で設定してくれる感じです。

※「じーじーじ ５０１（平仮名が含まれる）」や「ジージージー 501（カタカナが含まれる）」や「GGG-501（ハイフンが含まれる）」など入力させたらエラーメッセージを表示させます。

※ちなみにこのシートには

''*******************************************************************************
' セル選択によるイベント
'*******************************************************************************

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'カレンダーフォームのVBA

If Intersect(Target, Range("BP1")) Is Nothing Then Exit Sub

If MsgBox("日付を記入するためカレンダーを表示させます、よろしいでしょうか？", vbYesNo) = vbNo Then

Exit Sub

Else

End If

' カレンダーフォームを起動する

Call ShowCalendarFromRange2(Target)

Dim ans As String
ans = InputBox("指定した時間（〇〇:〇〇）を入力して下さい。")

If ans = "" Then Exit Sub

Range("CO14").Value = ans

ans = InputBox("先ほど指定した時刻からの時間間隔(例えば５分なら「５」で1時間なら「６０」を入力して下さい。 ")

If ans = "" Then Exit Sub

For Each c In Range("CO15:CO37")
c.Value = Format(c.Offset(-1).Value + TimeValue((ans \ 60) & ":" & (ans Mod 60)), "hh:mm")

Next

End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Intersect(Target, Range("A3,A4,A5,A6,A7,A8,A9,A10,A11,A42,A43,A44,A45,A46,A47,A48,A49,A50,A81,A82,A83,A84,A85,A86,A87,A88,A89,A120,A121,A122,A123,A124,A125,A126,A127,A128,A159,A160,A161,A162,A163,A164,A165,A166,A167,A198,A199,A200,A201,A202,A203,A204,A205,A206,A237:A245")) Is Nothing Then Exit Sub
Cancel = True
With Target(1) '
If .Value = "" Then
.Value = Now()
.NumberFormatLocal = "h:mm"
Else
.Value = ""
End If
End With

End Sub

のＶＢＡが組み込まれています。

回答No.3

tsubu-yuki · ベストアンサー

空白だったら何もしないで処理終了

を書き加えればいいですよ。

お礼

ありがとうございました。
参考になりました。

回答No.2

tsubu-yuki

> VBAの選択範囲を間違えていました。B13～CM14の範囲で、セルが結合した範囲もあり（B１３～D１４までなど）セルが結合した範囲もエラーチェックでクリアしなければいけません。

その辺りはご自身で応用なさってください。
ダブルクリック前のロジックで対象範囲を指定なさっているようですから
その応用で充分に事足りるはずです。

それに、要件後付けをし出すとキリが無いですから。

> エラーデータチェックのMsg　boxが出現した後に文字がクリアされますが、その後に文字を入力すると半角大文字にするVBAが作動しません。

失礼、１行抜けていました。

そんなわけで、改めて。
　　　　　　　　　　MsgBox ("指定外文字　　" & "" & Mid(myStr, i, 1) & "")
　　　　　　　　　　Target.Select　　　　　　　　　　　'入れ替え
　　　　　　　　　　Selection.ClearContents　　　　　　' 少し修正
　　　　　　　　　　Application.EnableEvents = True　　　' 追加
　　　　　　　　　　Exit Sub

お礼

ありがとうございました。
参考になりました。

補足

質問に答えて頂き誠にありがとうございます。
色々と勉強になりました。
実際にＶＢＡを作動させてみて文字を入力したらしっかり自動変換されています。
しかし自動変換された文字をデリートして空白にすると「型が一致しません。」と表記され「Target = StrConv(Target, vbUpperCase + vbNarrow)」の部分が黄色く色が塗られます。
どの様に対応すれば宜しいでしょうか？

回答No.1

tsubu-yuki

とりあえず。
「半角大文字にする」だけなら
Private Sub Worksheet_Change(ByVal Target As Range)
　　Application.EnableEvents = False
　　Target = StrConv(Target, vbUpperCase + vbNarrow)
　　Application.EnableEvents = True
End Sub
で出来ます。
対象を限定するのなら、質問文中の
「特定のセルがアクティブになったらカレンダーを表示する」
モノを参考に追記してくださいませ。

エラーデータ入力のチェックについては・・
とりあえずアレコレ考えずに
文字コードを１文字ずつチェックする例です。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myAsc As Integer, InSP As Integer, myFlag As Integer
Dim myStr As String

　　Application.EnableEvents = False
　　Target = StrConv(Target, vbUpperCase + vbNarrow)
　　myStr = Target.Value

　　InSP = 0: myFlag = 0
　　For i = 1 To Len(myStr)
　　　　myAsc = Asc(Mid(myStr, i, 1))
　　　　If Not (myAsc >= 65 And myAsc <= 90) Then
　　　　　　If Not (myAsc >= 48 And myAsc <= 57) Then
　　　　　　　　If myAsc = 32 Then
　　　　　　　　　　InSP = i
　　　　　　　　Else
　　　　　　　　　　MsgBox ("指定外文字　　" & "" & Mid(myStr, i, 1) & "")
　　　　　　　　　　Target.ClearContents
　　　　　　　　　　Target.Select
　　　　　　　　　　Exit Sub
　　　　　　　　End If
　　　　　　ElseIf myFlag = 0 And InSP = 0 Then
　　　　　　　　myFlag = i
　　　　　　End If
　　　　End If
　　Next
　　If myFlag <> 0 Then
　　　　Target.Value = Left(myStr, myFlag - 1) & " " & Mid(myStr, myFlag, 99)
　　End If
　　Application.EnableEvents = True
End Sub

そんなに難しいことを書いているつもりも無いので解説は割愛。

ところで、質問の本筋からは逸れてしまうのですが・・
> 英字と数字の間に半角で１角の空欄を自動でしてくれる様にする
> 英字と数字の間に１角の半角で空白が自動で設定してくれる
私は「英字と数字の間に半角スペースを自動で入力する」と
読んだのですが、間違いないでしょうか。
出来れば特に「１角」「設定してくれる」について、
解り易い日本語で補足いただけると幸いです。

お礼

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myAsc As Integer, InSP As Integer, myFlag As Integer
Dim myStr As String

　　Application.EnableEvents = False
　　Target = StrConv(Target, vbUpperCase + vbNarrow)
　　myStr = Target.Value

　　InSP = 0: myFlag = 0
　　For i = 1 To Len(myStr)
　　　　myAsc = Asc(Mid(myStr, i, 1))
　　　　If Not (myAsc >= 65 And myAsc <= 90) Then
　　　　　　If Not (myAsc >= 48 And myAsc <= 57) Then
　　　　　　　　If myAsc = 32 Then
　　　　　　　　　　InSP = i
　　　　　　　　Else
　　　　　　　　　　MsgBox ("指定外文字　　" & "" & Mid(myStr, i, 1) & "")
　　　　　　　　　　Target.ClearContents
　　　　　　　　　　Target.Select
　　　　　　　　　　Exit Sub
　　　　　　　　End If
　　　　　　ElseIf myFlag = 0 And InSP = 0 Then
　　　　　　　　myFlag = i
　　　　　　End If
　　　　End If
　　Next
　　If myFlag <> 0 Then
　　　　Target.Value = Left(myStr, myFlag - 1) & " " & Mid(myStr, myFlag, 99)
　　End If
　　Application.EnableEvents = True
End Sub
補足の部分で書き忘れていました。
VBAの選択範囲を間違えていました。B13～CM14の範囲で、セルが結合した範囲もあり（B１３～D１４までなど）セルが結合した範囲もエラーチェックでクリアしなければいけません。
またエラーデータチェックのMsg　boxが出現した後に文字がクリアされますが、その後に文字を入力すると半角大文字にするVBAが作動しません。

補足

日本語が伝わりにくくて申し訳ありません。
「英字と数字の間に半角スペースを自動で入力する」で間違いないです。