名前の名字の間のスペースについて

名前と名字の間に全角のスペースを入れる作業をしています。

例
①　小野瀬　太郎の場合は何もしない
②　小野瀬太郎の場合は間にスペースをいれる


Range("a1", Cells(n, 1)).Replace "小野瀬", "小野瀬　", xlPart, xlByRows
上記の場合ですとどちらもスペースが入ってしまいます。
①の場合はそのまま何もしない
②の場合は小野瀬と太郎の間にスペースを入れる

もし可能であれば小野瀬以外に佐々木や長谷川など三文字の名字の人は名前と名字の間にスペースがいれられればと思います。

現在は
Range("a1", Cells(n, 1)).Replace "川野辺", "川野辺　", xlPart, xlByRows
Range("a1", Cells(n, 1)).Replace "大和田", "大和田　", xlPart, xlByRows
Range("a1", Cells(n, 1)).Replace "長谷川", "長谷川　", xlPart, xlByRows
Range("a1", Cells(n, 1)).Replace "生田目", "生田目　", xlPart, xlByRows
Range("a1", Cells(n, 1)).Replace "長谷澤", "長谷澤　", xlPart, xlByRows

こんな感じです。

どなたかご教授よろしくお願い致します。

No.2 ベストアンサー 回答者： fujillin 回答日時： 2017/12/26 17:21

こんにちは

とりあえず、ご提示の方法を踏襲するなら、先に既にスペースが入っている"小野瀬　"を"小野瀬"にしておくとかで対応できそうな気がします。
　Range(範囲).Replace what:="小野瀬　", replacement:="小野瀬", lookat:=xlPart
　Range(範囲).Replace what:="小野瀬", replacement:="小野瀬　", lookat:=xlPart

この方法の長所は、一度マクロを実行したシートに対して、再度マクロを実行したとしても変わらないという点かな？
（実行するたびにスペースが増加してゆくことはなくなる）

※ 既存のスペースが半角、全角いろいろある場合は、両方とも一旦削除するようにしておけばよろしいかと。

No.5 回答者： WindFaller 回答日時： 2017/12/27 18:07

私の読み違えでなければ、A列のリストになっているものだと解釈しました。

今回のような場合は、全部にまとめてするのではなく、個別に処理したほうがよいのではないでしょうか。

本来は、日本語形態素解析の　Kakasi を使って、名前と名字を別けます。そのためには辞書を使います。

https://oshiete.goo.ne.jp/qa/9796014.html
で書きました。辞書を入れなくてもに、かなりの精度で分かち書きが可能です。
ただ、そこまでお望みでないのでしたら、以下のような方法があります。

　　　''スペースを抜いてしまう場合
　　　buf = Replace(buf, Space(1), "", , , vbTextCompare)
この部分は抜いてもよいでしょう。これを入れればやり直しが可能です。

なお、以下は、その全てを可能にするものではありません。富士通の教材唐でチェックしました。

'//
Sub SpaceInNames()
　Dim Rng As Range
　Dim mSpace As String
　Dim c As Range
　Dim buf As String
　Dim spcFlg As Boolean
'****ユーザー設定**
　Set Rng = Range("A1", Cells(Rows.Count, "A"))
　mSpace = Space(1)　' 半角スペース 任意
'****設定終わり**
' Application.ScreenUpdating = False
　For Each c In Rng
　　If Trim(c.Value) <> "" Then
　　　buf = c.Value
　　　''スペースを抜いてしまう場合
　　　buf = Replace(buf, Space(1), "", , , vbTextCompare)
　　　'スペースのある場合
　　　If InStr(1, buf, Space(1), vbTextCompare) > 0 Then
　　　　Do
　　　　　buf = Replace(buf, Space(2), Space(1), , , vbTextCompare)
　　　　　DoEvents
　　　　Loop Until InStr(1, buf, mSpace, vbTextCompare) = 1

　　　　c.Value = buf
　　　Else
　　　　Select Case LenB(StrConv(buf, vbFromUnicode))
　　　　　Case 4
　　　　　　buf = Mid(buf, 1, 1) & mSpace & Mid(buf, 2)
　　　　　Case 6
　　　　　　buf = Mid(buf, 1, 2) & mSpace & Mid(buf, 3)
　　　　　Case 8
　　　　　　buf = Mid(buf, 1, 2) & mSpace & Mid(buf, 3)
　　　　　Case Is >= 10
　　　　　　'2番目の漢字が田か村・・で、3文字目が目でないこと
　　　　　　If Mid(buf, 2, 1) Like "[田村中井藤吉]" And _
　　　　　　 Mid(buf, 3, 1) Like "[!目木]" Then
　　　　　　　buf = Mid(buf, 1, 2) & mSpace & Mid(buf, 3)
　　　　　　　'3番目がひらがな、カタカナ
　　　　　　ElseIf Mid(buf, 3, 1) Like "[あ-んア-ン]" Then
　　　　　　　buf = Mid(buf, 1, 2) & mSpace & Mid(buf, 3)
　　　　　　Else
　　　　　　　buf = Mid(buf, 1, 3) & mSpace & Mid(buf, 4)
　　　　　　End If
　　　　　Case Else
　　　　　　buf = Mid(buf, 1, 2) & mSpace & Mid(buf, 3)　'暫定的
　　　　End Select
　　　　c.Value = buf
　　　End If
　　End If
　Next
' Application.ScreenUpdating = True
End Sub
'//

Application.ScreenUpdating をコメントアウトしているのは、目で確認したいからで、シングルクォートを取ってしまってもよいです。

No.4 回答者： 細うどん 回答日時： 2017/12/27 16:11

Likeが使えると思います。

if not cells(n,1) like “* *” then
end if

入力環境の都合上半角スペースになっていますが、
このif条件に入れればスペースを含まないもののみ処理します。

以上ご参考まで

No.3 回答者： bonaron 回答日時： 2017/12/26 17:38

スペースを入れた後で

２個続きのスペースを１個に変換するとか。

No.1 回答者： tarakojii 回答日時： 2017/12/26 16:51

①　小野瀬　太郎の場合は瀬と太の間は数字にしてスペースするとバランスよくなりますよ。