エクセルで特定スペースの抽出

エクセルで特定スペースの抽出

エクセルである列のセルにスペースを入れる際にはルールがあります。



そのルールというのは“アルファベット間のみスペース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個目のスペースやアルファベット以外の半角文字がある場合にはひねりが必要になります。



必要であれば考えますので完璧なサンプルのご提示をお願いします。