文字列変換

質問

添付図をご覧ください。
範囲 A1:B6 に英語の人名が入力されています、。
セル A7 に式 =SUBSTITUTE(A1," ","") を入力して、此れを右および下方にオートフィルしたものを範囲 A7:B12 に示しています。

此処で質問ですが、最初に下表に示すスペースなしの文字列データがあった場合、此れを上表に示すデータに変換する数式を教えてください。
マクロ音痴の私のために、どうか数式でお願いします。
数式が短くなるなら、配列数式でも構いませんが、補助列(行)等を使用しないことを希望いたします。

回答No.5

kagakusuki · ベストアンサー

回答No.1、4です。

　「Mc」、「Mac」、「O'」以外にも「FitzGerald」の「Fitz」というパターンがある事が判りました。

【参考URL】
　フィッツジェラルド - Wikipedia
　　https://ja.wikipedia.org/wiki/%E3%83%95%E3%82%A3%E3%83%83%E3%83%84%E3%82%B8%E3%82%A7%E3%83%A9%E3%83%AB%E3%83%89

　ですから、回答No.4の関数を次の様なものに修正して下さい。

=TRIM(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(A1,"A"," A"),"B"," B"),"C"," C"),"D"," D"),"E"," E"),"F"," F"),"G"," G"),"H"," H"),"I"," I"),"J"," J"),"K"," K"),"L"," L"),"M"," M"),"N"," N"),"O"," O"),"P"," P"),"Q"," Q"),"R"," R"),"S"," S"),"T"," T"),"U"," U"),"V"," V"),"W"," W"),"X"," X"),"Y"," Y"),"Z"," Z"),"Mc ","Mc"),"Mac ","Mac"),"O' ","O'"),"Fitz ","Fitz"))

　後それから、

>》 という条件はあまり重視しなくても宜しいのでしょうか？
>と仰った意味が理解できずに、少々戸惑っております。

の件ですが、これは私の述べ方が少々悪かったかも知れません。
　要するに、「(別のやり方としてマクロを使った方法もあるので)他の回答者の方の様に、マクロを使った方法を回答しても宜しいでしょうか？」という事を言いたかった訳です。

　例えば、以下の様なVBAの構文を、回答No.2様の御回答と同様にVBEの画面の標準モジュールに貼り付けてからそのVBAを保存しておきますと、そのVBAを貼り付けたファイル内限定でSPACEINSERT関数という新たな関数(ユーザー定義関数)が使用可能になり、他の関数と同様にセル内に

=SPACEINSERT(A1)

と入力しますと、A1セルに入っている文字列に含まれている大文字の前に半角スペースが挿入された文字列が表示されます。(「A1」の代わりに他のセルを参照する事や、セルの代わりに文字列データを使う事も出来ます)

【参考URL】
　ユーザー定義関数
　　http://www.konomiti.com/Ex_kan_05.html

　但し、文頭にある大文字や、「Mc」、「Mac」、「O'」、「Fitz」の直後にある大文字の直前にはスペースが挿入されない様になっております。
　又、大文字が3文字以上連続していて、尚且つ、その連続箇所の直後に「空白スペースや数字、或いは『.』、『+』、『-』、『/』、『=』」以外の文字が続いている箇所は何かの略称として扱い、大文字が連続している箇所の前後にのみ半角スペースを挿入し、連続している箇所の途中には空白の挿入は行われません。
　又、大文字が2文字以上連続していて、尚且つ、その連続箇所の直後に「空白スペースや数字、或いは『.』、『+』、『-』、『/』、『=』」の内の何れかの文字が続いている箇所は何かの略称として扱い、大文字が連続している箇所の直前にのみ半角スペースを挿入し、連続している箇所の途中には空白の挿入は行われません。

Function SPACEINSERT(元の文字列 As Variant) As String

Dim buf As Variant, i As Long, Mc As Variant
Mc = Array("Mc", "Mac", "O'", "Fitz")

buf = 元の文字列
If buf & "" <> "" Or Not IsError(buf) Then
buf = Replace(Replace(buf, Chr(28), ""), Chr(29), "") & Chr(28)
For i = 65 To 90
buf = Replace(buf, Chr(i), Chr(28) & Chr(i))
Next i
For i = 0 To UBound(Mc)
buf = Replace(buf, Mc(i) & Chr(28), Mc(i))
Next i
For i = Len(buf) To 3 Step -1
If Mid(buf, i, 1) = Chr(28) _
And Mid(buf, i - 2, 1) = Chr(28) _
And (Mid(buf & " ", i + 2, 1) Like _
"[ ,　," & Chr(29) & ",.,+,-,/,=,0-9]" _
Or Mid(" " & buf, i - 2, 1) = Chr(28)) Then
buf = WorksheetFunction.Replace(buf, i, 1, Chr(29))
If Not Mid(buf, i + 2, 1) Like "[" & Chr(29) & ".,+,-,/,=,0-9]" Then _
buf = WorksheetFunction.Replace(buf, i + 2, 0, Chr(28))
End If
Next i
buf = WorksheetFunction.Trim(Replace(Replace(buf, Chr(29), ""), Chr(28), " "))
End If
SPACEINSERT = buf

End Function

Private Sub Workbook_Open()

Application.MacroOptions Macro:="SPACEINSERT", _
Description:="文字列の途中または末尾に含まれているアルファベットの大文字" _
& "の前に半角スペースが挿入された文字列を返すユーザー定義関数です。" _
& vbCrLf & "但し、何かの略称や、特定の苗字と考えられるものの途中には" _
& "空白の挿入は行われない事があります。"

End Sub

補足

》 「…マクロを使った方法を回答しても宜しいでしょうか？」という事を
》 言いたかった訳です。
本音を申せば、「宜しくないので、マクロ案は御遠慮願いたい」です。

回答No.4

kagakusuki

回答No.1です。

>英字名の中で同様の例は Mc、Mac 以外にも存在するのでしょうか？

　McやMacはゲール語で「息子」を表す言葉で、例えば「MacArthur」の場合は「Arthurの子孫」という意味なのだそうです。
　同様のものに「Kevin J. O'Connor」や「Willis O'Brien」の「O'」がありますが、それ以外にもあるのかどうかはちょっと私には判りかねます。

【参考URL】
　マック (ゲール語) - Wikipedia
　　https://ja.wikipedia.org/wiki/%E3%83%9E%E3%83%83%E3%82%AF_(%E3%82%B2%E3%83%BC%E3%83%AB%E8%AA%9E)

　もし「Mc」、「Mac」、「O'」だけであれば次の様な関数で対処出来るかとは思います。

=TRIM(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(A1,"A"," A"),"B"," B"),"C"," C"),"D"," D"),"E"," E"),"F"," F"),"G"," G"),"H"," H"),"I"," I"),"J"," J"),"K"," K"),"L"," L"),"M"," M"),"N"," N"),"O"," O"),"P"," P"),"Q"," Q"),"R"," R"),"S"," S"),"T"," T"),"U"," U"),"V"," V"),"W"," W"),"X"," X"),"Y"," Y"),"Z"," Z"),"Mc ","Mc"),"Mac ","Mac"),"O' ","O'"))

　尤も、変換する文字列が人名とは限らず、例えば「オペレーションソフトウェア」という意味を持つ「OS」などの略称が含まれている文章なども変換しなければならない場合や、「Gilbert O'Sullivan」の「'」が抜けて「Gilbert OSullivan」となっているものまで変換しなければならない様な場合には、自動化は困難なのではないかと思います。

　それから、ちょっと確認しておきたいのですが、他の回答者の方からマクロを使った方法が回答されて来ておりますが、

>マクロ音痴の私のために、どうか数式でお願いします。

という条件はあまり重視しなくても宜しいのでしょうか？

お礼

なるほど、一旦前回の方法で全大文字の前にスペースを入れた後で、「Mc 」や「Mac 」だけをそれぞれ「Mc」や「Mac」に戻すと。つまり、
「WilliamMcKinley」→「William Mc Kinley」→「William McKinley」
「DouglasMacArthur」→「Douglas Mac Arthur」→「Douglas MacArthur」
ということですね。
この度は、誠にありがとうございました。

ついでながら、
》 という条件はあまり重視しなくても宜しいのでしょうか？
と仰った意味が理解できずに、少々戸惑っております。

回答No.3

山田 太郎（@f_a_007）

No1さんのやり方を標準モジュールにAppendSpaceという名前で登録すれば添付図のように簡略化できます。もちろん、そっくりそのままコピーするやり方と考え方だけコピーするやり方があるかと思います。

Option Explicit

Public Function AppendSpace(ByVal strText As String) As String
　　Dim I　　　　　As Integer
　　Dim L　　　　　As Integer
　　Dim strNewText As String
　　Dim strC　　　 As String

　　strNewText = Left(strText, 1)

　　L = Len(strText)
　　For I = 2 To L
　　　　strC = Mid(strText, I, 1)
　　　　If strC >= "A" And strC <= "Z" Then
　　　　　　strNewText = strNewText & " "
　　　　End If
　　　　strNewText = strNewText & strC
　　Next I
　　AppendSpace = strNewText
End Function

お礼

ありがとうございました。

回答No.2

imogasi

質問を言葉で言い表すと、「大文字の出現する前の位置に,１スペースを入れたい」というべきところか。ただし２番目に出現した位置の前に？
これを書いておくと、課題がすぐわかる。図が一番わかりやすいというのは、そうでないと思うが、判ってない質問者が多いので苦労する。図＋説明文が一番良い。
ーー
エクセル関数には大文字の位置を探す関数はないと思う。
それで「マクロ音痴の私のために」と書いてあるが、私製の関数を定義してやってみた。
一般の関数だって、中でどう処理されているか、質問者は知りはしないだろう。それとおなじだ。
私製関数
ＶＢＥの画面を出して（シート画面で、ＡＬＴ＋Ｆ１１キー）、そこに標準モジュール画面を出して
Function uppos2(s)
P = 0
'MsgBox s
'ss = Application.WorksheetFunction.upper(s) 'ダメだった
ss = StrConv(s, 1)
'MsgBox ss
For i = 1 To Len(s)
If Mid(s, i, 1) = Mid(ss, i, 1) Then
P = P + 1
If P = 2 Then
uppos2 = i
End If
End If
Next i
P = 0
End Function
を貼り付け。
シートに戻って
Ａ１にGeorgeWashinton　質問図のＡ７に当たる
Ｂ１に
=MID(A1,1,uppos2(A1)-1) & " " & MID(A1,uppos2(A1),LEN(A1)-uppos2(A1)+1)
結果 B1セル
George Washinton
ーーーー
質問の目的を小生が誤解していたらすみません。無視してください。
ーー
通常エクセル関数では無理と思う。
他の人が配列数式での回答が出るかもしれないが、式の長さは長く、式の組み合わせの理解も、質問者には、むつかしい式になるだろうと予想。
この問題そのものが、エクセル関数向けではないということかと思う。

お礼

御高説を承り、誠に忝く存じます。

回答No.1

kagakusuki

例えばA1に入力されている文字列に対して、御質問の様な変換を行う場合には、次の様な関数となります。

=TRIM(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(A1,"A"," A"),"B"," B"),"C"," C"),"D"," D"),"E"," E"),"F"," F"),"G"," G"),"H"," H"),"I"," I"),"J"," J"),"K"," K"),"L"," L"),"M"," M"),"N"," N"),"O"," O"),"P"," P"),"Q"," Q"),"R"," R"),"S"," S"),"T"," T"),"U"," U"),"V"," V"),"W"," W"),"X"," X"),"Y"," Y"),"Z"," Z"))

お礼

凄いチカラワザだけど、その手がありましたね。
ありがとうございました。

でも一つ難点を発見しました。
William McKinley → WilliamMcKinley (添付図のセル A10)
Paul McCartney → PaulMcCartney
Ronald McDonald → RonaldMcDonald
Douglas MacArthur → DouglasMacArthur
の場合の、右から左への変換が崩れます。
この場合は、手動でやることにします。

英字名の中で同様の例は Mc、Mac 以外にも存在するのでしょうか？