VBA エクセル 全角 半角

全角ならOK、半角ならNGと表示させるなら以下の計算式でいいと思います。
これを最終行を取得し、再終行までを判断させるマクロを教えて下さい。
=IF(LEN(A1)*2-LENB(A1)=0,"OK","NG")

よろしくお願いいたします。

No.3 ベストアンサー 回答者： JazzCorp 回答日時： 2013/04/08 08:33

Option Explicit

Sub 全角だけならOK()
Dim xChar As Range
Columns("B").ClearContents
For Each xChar In Range("A1", Cells(Rows.Count, "A").End(xlUp))
If Not IsEmpty(xChar.Value) Then
If (StrConv(xChar.Value, vbWide) = xChar.Value) Then
xChar.Offset(, 1).Value = "OK" '全角だけ
Else
xChar.Offset(, 1).Value = "NG"
End If
End If
Next
End Sub

No.2 回答者： keithin 回答日時： 2013/04/08 00:30

何をしたいのですか。

＞再終行までを判断させる

sub macro1()
　dim h as range
　for each h in range("A1:A" & range("A65536").end(xlup).row)
　　if len(strconv(h, vbfromunicode)) * 2 - lenb(strconv(h, vbfromunicode)) <> 0 then
　　　msgbox "NG"
　　　exit sub
　　end if
　next
　msgbox "OK"
end sub


sub macro2()
range("B1:B" & range("A65536").end(xlup).row).formula = "=IF(LEN(A1)*2-LENB(A1)=0,""OK"",""NG"")
end sub


sub macro3()
　dim h as range
　for each h in range("A1:A" & range("A65536").end(xlup).row)
　　h.select
　　if len(strconv(h, vbfromunicode)) * 2 - lenb(strconv(h, vbfromunicode)) <> 0 then
　　　msgbox "NG"
　　else
　　　msgbox "OK"
　　end if
　next
end sub

No.1 回答者： WindFaller 回答日時： 2013/04/08 00:22

2つの方法があります。

ひとつは、質問の数式通りの方法で、もうひとつは、全角にして比較する方法です。
VBAの扱う文字は、Unicodeですから、一旦、JISに戻さないと、LenBのバイトデータが取れません。
なお、他にも、もう一つ代表的な方法があります。

'//
Sub Test1()
Dim c As Variant
For Each c In Range("A1", Cells(Rows.Count, 1).End(xlUp))
　If LenB(StrConv(c.Value, vbFromUnicode)) = LenB(c.Value) Then
　　　c.Offset(, 1).Value = "OK"　'全角
　 Else
　　　c.Offset(, 1).Value = "NG"　'半角
　End If
Next c
End Sub


Sub Test2()
Dim c As Variant
For Each c In Range("A1", Cells(Rows.Count, 1).End(xlUp))
　If StrConv(c.Value, vbWide) = c.Value Then
　　　c.Offset(, 1).Value = "OK"　'全角
　 Else
　　　c.Offset(, 1).Value = "NG"　'半角
　End If
Next c
End Sub