VBAの入力規則について質問です。

質問

VBAの入力規則について質問です。

Excelで、D列は全角50文字（半角100文字）以内の入力を可能とし、
それ以上の入力の場合、エラーを表示させたいと思います。

全角と半角をバイト数で判別し、以下のようなコードを考えましたが、
全角の場合しかうまくできません。

Private Sub Worksheet_Change(ByVal Target As Range)

Dim ByteCount As Long
ByteCount = LenB(StrConv(Target, vbFromUnicode))

If Target.Column = 4 Then
Select Case ByteCount
Case Is > 100
With Target.Validation
.Add _
Type:=xlValidateTextLength, _
AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, Formula1:=1, Formula2:=100
.ErrorTitle = "入力エラー"
.ErrorMessage = "全角50文字（半角100文字）以内で入力してください。"
.IgnoreBlank = False
End With
Case 1 To 100
With Target.Validation
.Add _
Type:=xlValidateTextLength, _
AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, Formula1:=1, Formula2:=50
.ErrorTitle = "入力エラー"
.ErrorMessage = "全角50文字（半角100文字）以内で入力してください。"
.IgnoreBlank = False
End With
End Select
End If

End Sub

アドバイスをよろしくお願いいたします。

回答No.2

Wendy02 · ベストアンサー

>ファイルの軽量化のため、VBAで設定したいと思っています。
そういう趣旨なら、全部、マクロにしてしまえばいかがですか？

なお、CheckByte関数はおまけです。ESCを押した時に、バイト数で文字を切るプログラムです。Mid 関数では、Byte では切ることは出来ません。しかし、100Byte でもなると、長くなり、Application.Undo　のほうが楽です。
CheckByteは、また、Option 引数を付けなければ、バイト数をカウントすることになります。

'//
Const mLIMIT As Long = 10　　'文字制限数
Private Sub Worksheet_Change(ByVal Target As Range)
　Dim msgRtn As VbMsgBoxResult
　If Target.Column <> 4 Then Exit Sub 'D列
　If Target.Cells.Count > 1 Then Exit Sub
　If Target.Value = "" Then Exit Sub
　Application.EnableEvents = False
　If LenB(StrConv(Target.Value, vbFromUnicode)) > mLIMIT Then
　　msgRtn = MsgBox("全角50文字（半角100文字）以内で入力してください。", 16 + vbRetryCancel, "入力エラー")
　　If msgRtn = vbIgnore Then
　　　Application.SendKeys "[F2]"
　　　Application.EnableEvents = True
　　　Exit Sub
　　ElseIf msgRtn = vbCancel Then
　　　Application.Undo
　　　'Target.Value = CheckByte(Target.Value, mLIMIT) 'ESCで、文字を制限まで切る
　　　On Error GoTo 0
　　End If
　End If
　Application.EnableEvents = True
End Sub

Function CheckByte(ByVal strTxt As String, Optional ilimit As Long)
　'バイトで文字列を切る
　Dim i As Long
　Dim a()　As Byte
　Dim b(1) As Byte
　Dim cnt As Long
　Dim buf As String
　a = strTxt
　For i = 0 To UBound(a) Step 2
　　If CLng(a(i + 1)) < 10 Then
　　　cnt = cnt + 1
　　Else
　　　cnt = cnt + 2
　　End If
　　b(0) = a(i): b(1) = a(i + 1)
　　buf = buf & CStr(b())
　　If cnt >= ilimit Then
　　　Exit For
　　End If
　Next
　If ilimit > 0 Then
　　CheckByte = buf
　Else
　　CheckByte = cnt
　End If
End Function

お礼

ありがとうございます。
すばらしい動きになりました。
コードの全てを理解することはできないので、
理解できる部分のみ引用させていただきます。

回答No.3

Wendy02

修正：文字数制限は、10 から100 に換えてください。
'//
Const mLIMIT As Long = 100　　'文字制限数

回答No.1

Wendy02

なぜ、マクロにしているのかさっぱり分かりません。
一端、文字が入ってから、マクロで入力規則が設定されるわけですから、その前に、マクロでも判定しなければ、意味がないと思います。それに、入力規則の上から入力規則を設定しようとしても、エラーが発生してしまいますから、入力規則が設定されているか判定が必要になります。

----
入力規則の「ユーザー設定」で

数式
=AND(LENB(D1)>1,LENB(D1)<100)

----
エラーメッセージを
タイトル　入力エラー

「全角50文字（半角100文字）以内で入力してください。」

といればよいと思いますね。

----
一応、ここまでにしておきます。どうしたらよいかは、レスを付けてください。

補足

回答ありがとうございます。
マクロを使わずにセルに設定すると、ファイル容量が大きくなってしまうのです。
ここでは１列しか設定しませんでしたが、実際は５列あり、
データ件数も莫大な量です。
ファイルの軽量化のため、VBAで設定したいと思っています。