半角・全角スペースチェック

質問

エクセルのＶＢＡで質問です。
現在、仕事でデータのコンバートの作業をしています。
送られてくるデータはTXTもしくはCSVなのです。
それを決められたフォーマットに加工しています。
それで現在、置換やオートフィルタの組み合わせで行っている作業を
自動化できないかと思い質問させていただきます。

氏名を　性 名としたいのですが、姓と名の間に半角スペースとしたいのです。
ただ、送られてくるデータが全角スペースだったり、
半角スペースが3つあったりとバラバラの状態です。
なのでいつもは置換で半角スペースに変えながら、
オートフィルタで半角スペースひとつを含まないものを出して
修正している状態です。

ＶＢＡでこれらをチェックし、自動修正することは可能でしょうか？
よろしくおねがいします。

回答No.6

Wendy02

こんにちは。#4 のWendy02です。

関数でしたら、以下のようにすればよいと思います。元のデータは、全角の漢字でしょうから、ASC()関数が使えます。

例

A1:
abc　____efg

上記は、全角スペース+アンダーバー(_) ひとつを半角スペースとして３つあります。

=SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(ASC(TRIM(A1))," ","^",1)," ",""),"^"," ")

ですが、この数式を直接マクロに入れるのはちょっと無理ね……。
マクロで、関数を貼り付け、結果を再び値貼り付けするのが、もっとも速いかな？

回答No.5

SortaNerd

私なら「半角スペース2つを1つに置換」を数回繰り返し、「全角スペースを半角スペースに置換」しますね。

それと注意事項なんですが、＞No1～4さん
ここの掲示板には連続した半角スペースが書き込めない仕様になっています。
記述内容に連続したスペースがあれば1個に自動変換されます。
例：「 」←10個書いた
もしソース内に連続スペースを使っていたらお気をつけください。

回答No.4

Wendy02

こんにちは。

一応、状況に合わせてワークシートで使えるように直してみました。
以下を、標準モジュールに貼り付けて、ワークシートに戻って、Alt + F8 または、コマンドボタンに取り付けてください。

最初に、場所を指定されますので、該当する列のどの行のセルでもいいので、ひとつ選択します。なお、自動修正として、入力した際に、チェックする場合は、コードが異なります。

'標準モジュールに限ります。
'-------------------------------------------------------
Sub MainSpaceDel()
'Ver.2647729.02
'半角・全角を半角ひとつにするマクロ
Dim rng As Variant
Dim cl As Integer
Dim EndCell As Range
Dim TopCell As Range
Dim c As Variant
With Application
　.DisplayAlerts = False
　On Error Resume Next
　Set rng = .InputBox("処理する列の任意のセルをクリックしてください", Type:=8)
　On Error Resume Next
　If TypeName(rng) <> "Range" Then Exit Sub
　.DisplayAlerts = True
End With
　 cl = rng.Cells(1).Column
　 Set EndCell = Cells(65536, cl).End(xlUp)
　 If EndCell.Row < 2 Then MsgBox "列が違うようです", 32: Exit Sub
　 Set TopCell = EndCell.End(xlUp)
　 Application.ScreenUpdating = False
　 For Each c In Range(TopCell, EndCell)
　　 If Not IsEmpty(c) Then
　　　 c.Value = SpaceOneRemain(c.Value)
　　 End If
　 Next c
　 Application.ScreenUpdating = True
　 Set rng = Nothing: Set EndCell = Nothing: Set TopCell = Nothing
End Sub

Function SpaceOneRemain(myText As Variant)
'2バイト空白を除去して半角空白ひとつにする関数
　Dim buf As String
　Dim i As Long
　If VarType(myText) = vbString _
　　And InStr(1, myText, Space(1), vbTextCompare) > 0 Then
　　buf = Trim$(myText)
　　buf = Replace(buf, Space(1), Space(1), , , vbTextCompare)
　　i = Len(myText) - Len(Replace(buf, Space(1), "", , , vbTextCompare))
　　buf = WorksheetFunction.Substitute(buf, Space(i), Space(1))
　Else
　　buf = myText
　End If
　SpaceOneRemain = buf
End Function
'-------------------------------------------------------

回答No.3

noname#95859

こんなのはどうでしょうか？
familynameの一覧表をテーブルとしてもちます。
対象のデータ（名前）をそのテーブルでスキャンして、
一致したら・・・・・・・

具体的に以下に示します。
シート”nameref"のA列に御社の社員？のfamilynameを登録しておきます。
（６５５３６を越えることはないと考えます）
シート”data”のA列には、対象の名前が記述されているとします。
例：
小泉純一郎
小泉　純一郎
小泉 純一郎

Sub Macro1()
Dim myArray As Variant

Sheets("nameref").Select
Erowpos = Range("A65536").End(xlUp).Address
hani = "$A$1:" & Erowpos
myArray = Range(hani).Value

r = UBound(myArray, 1) '行数

Sheets("data").Select
rowpos = 1
Do While Cells(rowpos, 1).Value <> ""
myname = Cells(rowpos, 1).Value
For i = 1 To r
If InStr(myname, Trim(myArray(i, 1))) > 0 Then
firstname = Trim(Replace(myname, Trim(myArray(i, 1)), ""))
targetname = Trim(myArray(i, 1)) & " " & firstname
Exit For
End If
Next
Cells(rowpos, 2).Value = targetname
rowpos = rowpos + 1
Loop

End Sub

このルーチンの実行結果は、B列に入ります。

このルーチンのポイントは、variant変数に配列を記憶させる点です。

ここでは、subrutineとしましたが、functionにすることも可能かと思います。

回答No.2

Wendy02

こんばんは。

以下をユーザー定義関数にするか、サブルーチンにすればよいかと思います。
myText の変数宣言と、myText の文字代入を削除して、

myText を以下のように引数にしてやり、

Sub Delete2ByteSpaces(myText As String)
として、MsgBox の代わりに、myText = buf にして、メインのコードから飛ばしてやればよいと思います。
また、以下のように、vbTextCompare　にすれば、全角空白は、半角空白に変わります。

Sub Delete2ByteSpaces()
'2バイト空白を除去
Dim buf As String
Dim myText As String
　myText = "あい　　うえお"
　buf = Trim$(myText)
　buf = Replace(buf, Space(1), Space(1), , , vbTextCompare) '全角を半角にする
　While InStr(buf, Space(2)) > 0
　 buf = Replace(buf, Space(2), Space(1))
　Wend
　MsgBox myText & " -> " & buf
End Sub

回答No.1

ASIMOV

「全角スペース」と「半角スペースが3つ」は
=TRIM(SUBSTITUTE(A1,"　"," "))
という関数で処理できますが、

１．姓（名）の中に余分なスペースがある（「山　田」等）
２．姓と名の間にスペースが入っていない物に自動的にスペースを入れる
は、ＶＢＡでも難しいと思います