[[20220130171225]]　『苗字と名前の間にスペースを入れるマクロ』（ガキ）　ページの最後に飛ぶ

『苗字と名前の間にスペースを入れるマクロ』（ガキ）

苗字と名前の間にスペースを入れるマクロを作成したいと思いました。
しかし、苗字と名前を判断させるのは難しいかと思ったのですが、同じ苗字のデータがあるのでそれが利用して判断できないでしょうか。

　　　Ａ　
　山田太郎
　山田次郎
　佐藤健司
　山田三郎
　

このように同じ苗字（山田）がいることがあるので、左から一文字ずつ一致するか判断させ、異なる文字が出てきたタイミングで名前と判断し、スペースを入れる、といったマクロができれば「山田太郎」→「山田　太郎」、「山田次郎」→「山田　次郎」、「山田三郎」→「山田　三郎」に修正されることができるかと考えました。
もちろん他の苗字（佐藤）については反映されないかと思うのですが、それは諦めます（手作業で修正します）。

そのようなマクロは作成できますでしょうか。
もちろん、これ以外でもスペースを入れる方法があれば、教えてください。
よろしくお願いいたします。

＜使用 Excel：Excel2019、使用 OS：Windows10 ＞

B列に、苗字の文字数（山田太郎なら　2）を、
目視確認しながら手作業で入力していくのはどうでしょうか。
そうすれば、スペース挿入は数式でできます。

（マナ） 2022/01/30(日) 18:21

マナさん

目視確認せずに自動化したかったのですが、そのような方法はないですか？

（ガキ） 2022/01/30(日) 19:03

お伝えし忘れていましたが、最初から「山田　太郎」とスペースが入った状態で入力されていることもあります。
スペースなしなら、全角スペースを入れる、といったようにしたいです。
（ガキ） 2022/01/30(日) 19:06

マクロ案がでるまでのつなぎで

では、B～F列に、１～５文字が一致するセル数を算出し
その最大値で、スペース挿入するのはどうでしょうか。

（マナ） 2022/01/30(日) 19:36

さネットでがせば、日本人の苗字のデータベースがないでしょうか。
そのリストを元に置換でスペースを付加するとか。

（マナ） 2022/01/30(日) 19:42

 名字由来net というサイトに全国の苗字ランキングがあります。
 パッと見、csv等は無さそうですがランキングをコピペすれば、データベースは作れそうです。

 ＞目視確認せずに自動化 
 森 永太郎と森永 太郎さんの様に、
 最終的に目視確認が必要になるケースはあると思いますよ。

 一例ですが、Sheet1のA列に苗字データベース、Sheet2のA列に氏名があるとして。
 ※最初からスペースがある場合等は、ご自身で対応して下さい。
 Sub Sample()
    Dim arr1, arr2, op
    Dim i As Long, j As Long
    With Worksheets("Sheet1")
        arr1 = Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp)).Value
    End With
    With Worksheets("Sheet2")
        arr2 = Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp)).Value
        ReDim op(1 To UBound(arr2, 1), 1 To 1)
        For i = 1 To UBound(arr2, 1)
            For j = 1 To UBound(arr1, 1)
                If InStr(arr2(i, 1), arr1(j, 1)) > 0 Then
                    op(i, 1) = Replace(arr2(i, 1), arr1(j, 1), arr1(j, 1) & " ")
                    Exit For
                End If
            Next j
        Next i
        .Cells(1, 2).Resize(UBound(op)) = op
    End With
 End Sub
（三文） 2022/01/30(日) 22:15

 >...それは諦めます（手作業で修正します）。
 セルの既存の振り仮名情報を破棄してしまいますが、それでも良ければ　↓　のような方法もあります。
 （処理対象のセルを選択してから「姓名分割」を実行）
 尚　結果はＩＭＥの辞書に依存しますので、辞書を鍛えれば変換精度は高くなるはずです。

 Sub 姓名分割()
     Dim N As Long
     Dim i As Long
     Dim W1 As Range
     Application.ScreenUpdating = False
     For Each W1 In ActiveWindow.RangeSelection
         If InStr(W1.Value, "　") = 0 Then
             N = 分割位置(W1)
             If N <> 0 Then W1.Value = WorksheetFunction.Replace(W1.Value, N, 0, "　")
         End If
     Next
     Application.ScreenUpdating = True
 End Sub
 Function 分割位置(ByVal Target As Range) As Long
     Dim W9 As Long
     Dim C As Long
     '--(1)
     If Len(Target) = 2 Then
         W9 = 2
     Else
         '--(2)
         On Error Resume Next
         With Target
             .Phonetics.Delete
             .SetPhonetic
             C = .Phonetics.Count
             If C = 2 Then W9 = .Phonetics(1).Length + 1
             .Phonetics.Delete
         End With
         On Error GoTo 0
     End If
     分割位置 = W9
 End Function

 他にもひらがなが含まれれば、そこを区切りとする等が考えられますが、上記には組み込んでいません。

（チオチモリン） 2022/01/31(月) 10:55

三文様

ありがとうございます。
「森永太郎」「森永太郎」の例はおっしゃるとおりだと思います。
しかし、行数がそんなにないので、そんなレアなケースには滅多に当たらないと期待しています。
また、苗字一覧があったとしても、「森」と「森永」の両方の苗字があるなら、結局は処理が失敗することがあるんですかね。

チオチモリン様
ありがとうございます。
辞書を使用することができるとは知りませんでした。
また、１行ずつの意味が理解できないところも多く勉強が必要ですね。
現在の私の知識では、やはり無理そうですね。
（ガキ） 2022/01/31(月) 11:21

 私のコードはデータベースを上の行から総当たりしているだけなので、
 文字数の多い苗字が上に来る様、あらかじめソートしておけば、ある程度の精度は出ると思います。
 上から「東、東海、東海林」となっていれば、全員、東で区切りになりますが、
 「東海林、東海、東」としておけば、該当苗字で区切れます。
 東海 林太郎さんにはゴメンなさいするとして。

 今回の場合、正解のデータが存在していない以上、
 目視チェック無しで完成とするのは無理がある気がします。
（三文） 2022/01/31(月) 12:29

 横入失礼します。
 |   左から一文字ずつ一致するか判断させ、異なる文字が出てきたタイミングで名前と判断し、スペースを入れる、といったマクロができれば
 そうだとすると、
 山田太郎
 山本一郎
 山崎二郎
 などは、
 山 田太郎
 山 本一郎
 山 崎二郎
 などとなってしまいませんか？

 どのくらいの件数か知りませんが、
 いずれ目視で確認することが必須でしょうから、
 次のような暫定策をとっておいて、
 あとで確認すれば済む話ではないですか？

 つまり、全員、姓は2文字であると決め打ちして、空白を入れたらどうですか？
 Left関数やMid関数で簡単にできるはずです。

 ちなみに、私がネット上の、とある名簿一覧で確認したら、
 200人中、3文字姓は4名、一文字姓は5人でした。
 95％は2文字です。
 一般化はできませんが、さほど大きな狂いはないと思われます。

 理論上、正確に判別できるわけではないので、それは諦めて、
 あれこれ考えているよりも、手を動かしたほうが早いと思いますよ。

（γ） 2022/01/31(月) 12:47

三分様
Ｙ様

そうですね。
ありがとうございます。
どのようにするか考えてみます。
（ガキ） 2022/02/01(火) 20:15

コメント返信：

[ 一覧(最新更新順) ]

[[20220130171225]] 『苗字と名前の間にスペースを入れるマクロ』（ガキ） ページの最後に飛ぶ

[[20220130171225]]　『苗字と名前の間にスペースを入れるマクロ』（ガキ）　ページの最後に飛ぶ