数字と数字のー（ハイフン）は消去しないＶＢＡ

質問

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

If Intersect(Target, Range("B4:CH4")) Is Nothing Then Exit Sub
If Application.CountBlank(Target) > 0 Then Exit Sub

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.Select '
Selection.ClearContents
Application.EnableEvents = True
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

B4:CH4の範囲で半角英数字の小文字で入力したら自動で大文字となり、－（ハイフン）を入力したら文字がクリアされるＶＢＡがあります。

質問ですが先ほどのＶＢＡで英字と数字の間のー（ハイフン）はクリア対象となり、数字と数字の間にー（ハイフン）の場合はクリアしないＶＢＡはどの様にすれば良いでしょうか？

※「GRE-879」の時は消去対象となり、「GRE868-76」の時は消去しない感じです。

回答No.1

tsubu-yuki · ベストアンサー

そんなに難しく考えずに、

半角ハイフン（"-" コードは45）かどうかだけ見て、
両隣が「数字以外」だったら消す

という具合で書いてあげれば良いかと思いますが・・
まぁ、この程度ならエラー処理は「Resume Next」で充分かと。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myAsc1 As Integer, myAsc2 As Integer, myAsc3 As Integer
Dim myStr As String

　　If Intersect(Target, Range("B4:CH4")) Is Nothing Then Exit Sub
　　If Len(Target.Value) = 0 Then Exit Sub

　　On Error Resume Next
　　Application.EnableEvents = False

　　Target = StrConv(Target, vbUpperCase + vbNarrow)
　　myStr = Target.Value
　　For i = Len(myStr) To 1 Step -1
　　　　myAsc1 = Asc(Mid(myStr, i, 1))
　　　　If myAsc1 = 45 Then
　　　　　　myAsc2 = Asc(Mid(myStr, i - 1, 1))
　　　　　　myAsc3 = Asc(Mid(myStr, i + 1, 1))
　　　　　　If Not (myAsc2 >= 48 And myAsc2 <= 57 And _
　　　　　　　　　myAsc3 >= 48 And myAsc3 <= 57) Then
　　　　　　　　Target.Value = Left(Target.Value, i - 1) & _
　　　　　　　　　　　　　　　Right(Target.Value, Len(Target.Value) - i)
　　　　　　End If
　　　　End If
　　Next

　　On Error GoTo 0
　　Application.EnableEvents = True
End Sub

とりあえず、行（列）削除と同じ要領で、文字列を後ろから見ていきます。
で、半角ハイフンが複数あると嫌なので、全桁について反復。
同じ理由からReplaceがうまくないので、LeftとRightで回りくどく。
・・・といった感じです。
ほんとは先頭・末尾がハイフンだったらも考えようとしたんですが、
同様の考え方でいけるので（面倒だったので）割愛です。

う～ん、あまりスマートではないな（汗）

お礼

この度は質問に答えていただきありがとうございます。
無事に解決出来ました。