入力した文字列の正誤チェック

質問

下記の様に動作するマクロを組みたいのですが、自分なりにチャレンジして
みましたが、意図した動作が実現できず困っています。ご教授お願い致します。

１．セルA1-A20にデータを入力。

2.予め作っておいた"確認"のコマンドボタンを押すと、入力した文字列が
　　"○○○○○-○"の7文字で構成される文字列になっているか確認し、
　　一つでも誤りがあれば"間違っています"、誤りがなければ"問題ありません"
　　と表示。※○に入る数値は、0-9の数字。

3.A1-A20のすべてのセルにデータを入力しない場合もあるので、空白が
　存在した時点でプログラムを終了。
※私が作ったプログラムは、すべてのセルに入力しないと誤った文字列が
　　　入っているのに、"問題ありません"と表示されてしまいます。

回答No.6

eden3616 · ベストアンサー

セルとあるので、Excelマクロかな？違っていたら無視してください。
VBAは標準で正規表現をサポートしていないので、RegExp オブジェクトを作成します。
下記のVBAコードを標準モジュールへ記述のうえ、Sample1を実行してください。

・A1～空白があるセル（最大A20）までを判定対象とします。
・正規表現によるマッチングで、一致しない場合は対象セルをセル選択して結果表示。
・全て一致した場合は「〇件、問題ありません」と表示。

コード的には下記サイトの正規表現によるマッチングコードを書き換えたものになります。
（参考にどうぞ）
http://officetanaka.net/excel/vba/tips/tips38.htm

■VBAコード
Sub Sample1()
　　Dim RE, r As Range
　　Dim myCell As Range, cnt As Integer
　　Set RE = CreateObject("VBScript.RegExp")
　　With RE
　　　　'正規表現を定義
　　　　.Pattern = "[0-9]{5}\-[0-9]" ''検索パターンを設定
　　　　.IgnoreCase = False　　　　 ''大文字と小文字を区別しない
　　　　.Global = True　　　　　　 ''文字列全体を検索
　　　　For Each r In Range("A1:A20")
　　　　　　If Len(r.Value) = 0 Then Exit For
　　　　　　'正規パターンの一致確認
　　　　　　If .Test(r.Value) Then
　　　　　　　　'正解数をカウント
　　　　　　　　cnt = cnt + 1
　　　　　　Else
　　　　　　　　'誤っているセルを格納
　　　　　　　　If myCell Is Nothing Then
　　　　　　　　　　Set myCell = r
　　　　　　　　Else
　　　　　　　　　　Set myCell = Union(myCell, r)
　　　　　　　　End If
　　　　　　End If
　　　　Next r
　　End With
　　'結果表示
　　If myCell Is Nothing Then
　　　　MsgBox cnt & "件、問題ありません"
　　Else
　　　　myCell.Select
　　　　MsgBox myCell.Count & "件の間違いがあります"
　　End If
　　Set RE = Nothing
　　Set myCell = Nothing
End Sub

お礼

ありがとうございました。
参考にさせて頂きます。

回答No.5

NotFound404

個人的にはこっちの方が好きです。
途中で抜け出さないで全部のセルA1～A20をチェックして
不備があるセル全てを選択状態にします。

Sub myCheck_2()
　　Dim R As Range
　　Dim S As String

　　For Each R In Sheets("Sheet1").Range("A1:A20")
　　　　If Not R.Value Like "[0-9][0-9][0-9][0-9][0-9]-[0-9]" Then
　　　　　　S = S & "," & R.Address
　　　　End If
　　Next
　　Debug.Print S

　　If Len(S) <> 0 Then
　　　　S = Mid(S, 2)
　　　　MsgBox "Nooooooo"
　　　　Range(S).Select
　　Else
　　　　MsgBox "Okkkkkkkkkkkk"
　　End If
End Sub

>VBAの質問をされる時は必ず作成されたコードを記載するようにしましょう。
Me too!

質問の趣旨とは離れてしまいますが
必ず２０個を正確に入力しなくてはいけないのなら
WorkSheetのChangeイベントで入力する都度チェックを行った方が
入力する側にとっては親切だと思います。

お礼

ありがとうございました。
参考にさせて頂きます。

回答No.4

dogs_cats

NotFound404 さんのNO３に回答されてる方法で質問内容はクリアされていると思います。
msgboxの表示はセルアドレスとOK又はNOを表示させた方がどのセルに誤りがあるかユーザーが判断し易いのではかと思い、NotFound404 さんのコードを若干変更したのが下記コードです。
おせっかいな話で申し訳ありません。

VBAの質問をされる時は必ず作成されたコードを記載するようにしましょう。

Sub myCheck()

Dim R As Range
Dim mystr As String

For Each R In Sheets("Sheet1").Range("A1:A20")

If R.Value = Empty Then Exit For

If Not R.Value Like "[0-9][0-9][0-9][0-9][0-9]-[0-9]" Then
mystr = mystr & R.Address(RowAbsolute:=False, ColumnAbsolute:=False) & "　NO" & vbCrLf
Else
mystr = mystr & R.Address(RowAbsolute:=False, ColumnAbsolute:=False) & "　OK" & vbCrLf
End If

Next

MsgBox mystr

End Sub

お礼

ご教授ありがとうございます。
勉強させて頂きます。

回答No.3

NotFound404

わざわざ Set してもメリットが無いので、こっちにします。
見つかった最初のセルに行くようにしました。

Sub myCheck()
Dim R As Range

For Each R In Sheets("Sheet1").Range("A1:A20")
If Not R.Value Like "[0-9][0-9][0-9][0-9][0-9]-[0-9]" Then
MsgBox "Nooooooo"
R.Select
Exit Sub
End If
Next

MsgBox "Okkkkkkkkkkkk"
End Sub

お礼

ご教授ありがとうございます。
勉強させて頂きます。

回答No.2

imogasi

Ａ列データ最下行を捉えるコードがわからないということかな。
余り現実的でない例題だがやってみた。
作る人によって、相当差があると思う。
例データ　Ａ列　Ｂ列は右側で、エラー指摘コメント
aaaaa-a
aaaa-a 入力文字に漏れあり
aaaaaa-a 入力文字余分文字あり
aaaaa-a
aaaaa-a
aaa-aa-a 入力文字余分文字あり
aaaaa-a
aaaaa-a
aaaaaaa -が漏れている
aaaaa-a
aaaaa-a
aaaaa-a
aaaaa-a
aaa-a 入力文字に漏れあり
aaaaa-a
aaaaa-a
aaaaa-a
標準モジュールに
Sub test01()
lr = Range("A1000").End(xlUp).Row
MsgBox lr
Select Case lr
Case 1
errmsg1 = "入力行なし "
MsgBox errmsg1
Exit Sub
Case Is > 20
errmsg1 = "入力２１行以上"
MsgBox errmsg1
Exit Sub
Case Else
End Select
'--
Range("B1:B20").Clear
For i = 1 To lr
errmsg2 = ""
t = Range("A" & i).Value
tl = Len(Range("A" & i).Value)
'--入力文字数
Select Case tl
Case Is < 7
errmsg2 = "入力文字に漏れあり "
Case 7
p = InStr(t, "-")
MsgBox i & " " & p
If p = 0 Then
errmsg2 = "-が漏れている"
ElseIf p <> 6 Then
errmsg2 = "-の前後の文字数が誤り"
Else
End If
Case Is > 7
MsgBox "AAAA"
errmsg2 = "入力文字余分文字あり"
End Select
p = InStr(t, "-")
If p = 0 Then
errmsg2 = "-が漏れている"
End If
Range("B" & i) = errmsg2
Next i
End Sub
Case文の利用とIf文が混じったが、統一することは簡単。
Ｉｎｓｔｒっ関数の部分はＭＩＤ関数でも似たもの。
「正規表現」を使うともう少し正確にチェックできるかもしれないが、質問者はそこまではいってないと推測した。
ーー
文章で表して、どういうチェックが出来るか列挙してみて、自分の置かれたニーズや自分の技量を考えてチェックする内容を決めるものだ。それ（チェックポイントがなにか）が質問に書いてない。
上記は急いで作ったもので、十分テストすること。
インプット（データ）チェックというのは、内容的に、難しいものだというのがわかりますか。本件は関連チェックが考えられていないのでその分簡単なんですが。

aaaaa-a
aaaaa-a

お礼

ご教授ありがとうございます。
勉強させて頂きます。

回答No.1

NotFound404

こんな風？

Sub myCheck()
Dim Rs As Range, R As Range
Set Rs = Range("A1:A20")
For Each R In Rs
If Not R.Value Like "[0-9][0-9][0-9][0-9][0-9]-[0-9]" Then
Set Rs = Nothing
MsgBox "Nooooooo"
Exit Sub
End If
Next

Set Rs = Nothing
MsgBox "Okkkkkkkkkkkk"
End Sub

お礼

ありがとうございました。
参考にさせて頂きます。