エクセルで特定スペースの抽出
エクセルである列のセルにスペースを入れる際にはルールがあります。
そのルールというのは“アルファベット間のみスペースOK”というものです。
例としては
『Yahoo JAPAN』⇒○
『YahooJAPAN』⇒○
『Yahoo！ JAPAN』⇒×
『ヤフー JAPAN』⇒×
『ヤフー ジャパン』⇒×
『ヤフージャパン』⇒○
『SUPER MARIO BROS』⇒○
『スーパーMARIO BROS』⇒○
『“SUPER” MARIO BROS』⇒×
などです。
そこでルールに“従っていない”セルを抽出したいのですが
何か良い方法はないでしょうか？
理想としてはマクロやVBAで
該当のセルに目印として色をつけたいのですが…。
ちなみに対象の列のセル数は10000前後。
エクセルのバージョンは2007です。
よろしくお願いします。
guranie_uさん
【補足に対する追記】***************
変更してみました。。
Sub Sample全角()
Dim i As Long, j As Long, k As Long
j = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To j
For k = 1 To Len(Cells(i, 1))
If Mid(Cells(i, 1), k, 1) = " " Then
If Mid(Cells(i, 1), k - 1, 1) Like "[!Ａ-Ｚ,!ａ-ｚ]" Or _
Mid(Cells(i, 1), k + 1, 1) Like "[!Ａ-Ｚ,!ａ-ｚ]" Then
Cells(i, 1).Interior.ColorIndex = 3
Exit For
End If
End If
Next k
Next i
End Sub
【最初の回答】
データの列はどこでしょうか?
とりあえず、A列A1～下にずーっとデータがあるとして、、
ルール違反のセルを赤く塗りつぶします。
Sub Sample()
Dim i As Long, j As Long, k As Long
j = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To j
For k = 1 To Len(Cells(i, 1))
If Mid(Cells(i, 1), k, 1) = " " Then
If Mid(Cells(i, 1), k - 1, 1) Like "[!A-Z,!a-z,!Ａ-Ｚ]" Or _
Mid(Cells(i, 1), k + 1, 1) Like "[!A-Z,!a-z,!Ａ-Ｚ]" Then
Cells(i, 1).Interior.ColorIndex = 3
Exit For
End If
End If
Next k
Next i
End Sub
＜マクロの貼り付け方＞
上記のコードをコピーして、、
エクセルのワークシート上で「Alt」+「F11」でVBE画面を出して、、
上のメニュー→「挿入」→「標準モジュール」をクリックして、
広い画面のカーソルが「テカテカ」しているところにコードを貼り付けます。
もうこの画面はいらないので、、右上の「×」で元のシートに戻ります。
＜マクロの実行＞
「Alt」+「F8」を押すと、マクロのダイアログが出てきますので、、
「Sample」が選択された状態で「実行」を押下します。。
Sub try()
Dim r As Range
With CreateObject("VBScript.Regexp")
' [ ]の中は半角スペース１個と全角スペース１個
.Pattern = "[^A-Za-zＡ-Ｚａ-ｚ]+[ ][^A-Za-zＡ-Ｚａ-ｚ]*"
.Global = True
' 例えばＡ列にデータがある場合
For Each r In Range("A1", Cells(Rows.Count, 1).End(xlUp))
' 除外する場合はセルを赤に
If .Test(r.Value) Then r.Interior.ColorIndex = 3
Next
End With
End Sub
的外れでしたらごめんなさい。
全角だと聞いて、修正しました。
--
1) Excelを起動します。
2) 「Alt + F11」を押してVBEを起動します。
3) 「挿入」→「標準モジュール」をクリック。
4) 開いたウインドウに下記のコードを貼り付けます。
5) F5キーを押せば、マクロが実行できます。
Sub check()
Dim N As Long '半角スペースが見つかった位置
Dim cnt As Long '半角スペースの個数
Dim String1 As String
Const String2 As String = " " '全角スペース
' Const String2 As String = " " '半角スペース
'【☆】半角スペースが見つかった位置を格納する配列。
'一つの文字列につき、最大で半角スペース20個以下を想定。
Dim spacePosition(20) As Long
Dim errorFlag As Boolean
Dim i As Long
Dim maxPos As Long
Dim focusPos As Long
Dim prevChar As String
Dim nextChar As String
Dim j As Long
Dim lastrow As Long
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
For j = 1 To lastrow
String1 = Cells(j, 1) '調べる文字列
'初期化
errorFlag = True
For i = 1 To 20
spacePosition(i) = 0
Next i
'文字列の中に、半角スペースが何個あるか数える
N = InStr(1, String1, String2)
If N > 0 Then
spacePosition(1) = N
End If
Do While N > 0
cnt = cnt + 1 '半角スペースが見つかった個数
N = InStr(N + 1, String1, String2) 'N番目に半角スペースがある。
spacePosition(cnt + 1) = N
' MsgBox N
Loop
' MsgBox """" & String2 & """" & "は、" & cnt & "個あります。"
'半角スペースが見つかった最後の位置を求めておく
For i = 1 To 20
If spacePosition(i) > 0 Then
maxPos = spacePosition(i)
Else
Exit For
End If
Next i
' MsgBox "半角スペースが出てきた最後の位置は" & maxPos
If cnt = 0 Then '半角スペースが見つからなかった場合
errorFlag = False
ElseIf spacePosition(1) = 1 Then '最初の1文字が半角スペースだった場合、エラー認定
errorFlag = True
ElseIf (Len(String1) > 0) And (maxPos = Len(String1)) Then '最後の1文字が半角スペースだった場合、エラー認定
errorFlag = True
Else
'少なくとも、最初と最後の文字は半角スペースではない場合
'スペースの両側の文字が、アルファベットか否かで判定する。
errorFlag = False 'ここまで来た場合、デフォルトをエラー無しに設定しておく。
For i = 1 To cnt
If spacePosition(i) > 0 Then
focusPos = spacePosition(i)
prevChar = Mid(String1, focusPos - 1, 1)
nextChar = Mid(String1, focusPos + 1, 1)
' MsgBox "前の文字は" & prevChar
' MsgBox "次の文字は" & nextChar
If (prevChar Like "[Ａ-ｚ]") And (nextChar Like "[Ａ-ｚ]") Then
' If (prevChar Like "[A-z]") And (nextChar Like "[A-z]") Then
' MsgBox "アルファベットです。"
'何もしない
Else
' MsgBox "アルファベットではない。"
errorFlag = errorFlag + True
End If
Else '全てのスペースについて調べ終えた
Exit For
End If
Next i
End If
If errorFlag = True Then
' MsgBox "エラーあり！"
Cells(j, 1).Interior.ColorIndex = 6
Else
' MsgBox "エラーなし"
End If
Next j
MsgBox "実行しました"
End Sub
とりあえず叩き台として
=IF(ISERROR(FIND(" ",A1)),"○",IF(LENB(MID(A1,FIND(" ",A1)-1,1))>1,"×","○"))
左から1個目の半角スペースの前のバイト数だけで判断させてます。
サンプルではこれで十分です。
スペースの右の文字は簡単に追加可能ですが、
2個目のスペースやアルファベット以外の半角文字がある場合にはひねりが必要になります。
必要であれば考えますので完璧なサンプルのご提示をお願いします。
