![](http://oshiete.xgoo.jp/images/v2/pc/qa/question_title.png?5a7ff87)
No.4ベストアンサー
- 回答日時:
板汚しすみません。
まだ半角スペース残ってた=CHOOSE(LEN(A2),,LEFT(A2,1)&REPT(" ",5)&RIGHT(A2,1),
REPLACE(LEFT(A2,B2),2,0,REPT(" ",B2-1))&REPT(" ",3)&REPLACE(RIGHT(A2,3-B2),2,0,REPT(" ",2-B2)),
IF(MOD(B2,2),LEFT(A2,B2)&REPT(" ",3)&RIGHT(A2,4-B2),
REPLACE(LEFT(A2,2),2,0," ")&" "&REPLACE(RIGHT(A2,2),2,0," ")),
IF(OR(B2=1,B2=4),LEFT(A2,B2)&REPT(" ",2)&RIGHT(A2,5-B2),
REPLACE(LEFT(A2,B2),2,0,REPT(" ",3-B2))&" "&REPLACE(RIGHT(A2,5-B2),2,0,REPT(" ",B2-2))),
LEFT(A2,B2)&" "&RIGHT(A2,6-B2),A2)
No.5
- 回答日時:
こんにちは。
とても気になった質問なので、私も本格的に試してみました。
なかなか手間の掛かる準備が必要です。
VBA系とは違う種類のプログラムですが、あえて、それをVBAでやってみました。
当然、VBAだけでは、不可能ですし、当然、関数だけでも不可能です。形態素解析のツールのkakasi を使って分かち書きをするわけですが、ただ、本来は人名辞典が必要です。MS-IMEの辞書は、今は抜き取れないのでしょうか?昔のWXの時代なら、取り出せたのですが。
Vector には以下のような人名辞書があります。WXIII用のものもあるようです。これは、テキストファイルですから、容易に抜き出せます。
http://www.vector.co.jp/vpack/filearea/data/writ …
今回は、私にとっても初めての組み込みで、デフォルトの辞書のままでやってみました。
「田中一」なら、反応するのに、「田中角栄」には反応しないという矛盾とも思える現象があります。
まず、Kakasi というプログラムを手に入れてください。
kakasi-2.3.4.zip
http://www.namazu.org/win32/
1)Windowsへの「kakasi」の導入方法
http://language-and-engineering.hatenablog.jp/en …
ここらを参考にしてみてください。Path をコンパネのシステムから加えるのもお忘れなく。
辞書は、mkkanwa.exe を使って作ります。
まだ、細かい所はチェックしていませんが、仕組みは分かっていただけるはずです。
'//
Sub KakasiForVBA()
Dim ret As Variant
Dim myName As String
Dim c As Variant, k As Long, k2 As Long
Dim fmt1 As String, fmt2 As String
Dim faName As String, fiName As String
With Range("B2", Cells(Rows.Count, 2).End(xlUp))
.ClearContents
.Font.Name = "MS ゴシック"
End With
For Each c In Range("A2", Cells(Rows.Count, 1).End(xlUp))
Application.ScreenUpdating = False 'ループが終わったら見えるようにする
Do
myName = Replace(c, Space(1), "", , , vbTextCompare)
Loop Until InStr(1, myName, Space(1), vbTextCompare) = 0
If c.Value Like "[一-龠]*" Then
ret = DivideName(CStr(c.Value))
ret = Application.Clean(ret)
ret = Trim(ret)
If ret <> "0" Then
k = InStr(ret, Space(1))
k2 = InStr(k + 1, ret, Space(1))
If k > 0 Then
'family name
If k2 = 4 Then
faName = Trim(Mid(ret, 1, k2 - 1))
Else
faName = Trim(Mid(ret, 1, k - 1))
End If
faName = Replace(faName, Space(1), "")
Select Case Len(faName)
Case 1: fmt1 = "@" & Space(3)
Case 2: fmt1 = "@ @"
Case 3: fmt1 = "@@@"
Case 4: fmt1 = "@@@@"
End Select
faName = Format$(faName, fmt1)
'first name
If k2 = 4 Then
fiName = Trim(Mid(ret, k2 + 1))
Else
fiName = Trim(Mid(ret, k + 1))
End If
fiName = Replace(fiName, Space(1), "")
Select Case Len(fiName)
Case 1: fmt2 = Space(4) & "@"
Case 2: fmt2 = Space(1) & "@" & Space(1) & "@"
Case 3: fmt2 = "@@@"
Case 4: fmt2 = "@@@@"
End Select
fiName = Format$(fiName, fmt2)
c.Offset(, 1).Value = Space(1) & faName & Space(1) & fiName
faName = "": fiName = ""
End If
End If
End If
Application.ScreenUpdating = True
Next
End Sub
Function DivideName(ByVal myName As String)
Dim WShell As Object
Dim oExec As Object
Dim sResult As String
Dim sCommand As String
Dim execmd As String
Dim nowDir As String
nowDir = ThisWorkbook.Path 'CurDir()
Set WShell = CreateObject("WScript.Shell")
ChDir "c:\kakasi"
execmd = " c:\kakasi\bin\kakasi.exe -w"
sCommand = "cmd /c echo " & myName & " |" & execmd 'kakasi -w"
Set oExec = WShell.Exec(sCommand)
Do Until oExec.Status: DoEvents: Loop
If Not oExec.StdErr.AtEndOfStream Then
sResult = oExec.StdErr.ReadAll
ElseIf Not oExec.StdOut.AtEndOfStream Then
sResult = oExec.StdOut.ReadAll
End If
If sResult <> "" Then
''Debug.Print sResult
DivideName = sResult
Else
DivideName = "0"
End If
ChDir nowDir
End Function
'//
注:このkakasiは、姓と名の分かち書きを任せているにすぎず、細かな調整をしているわけではありません。
![「Excelで名前の7文字組みの方法を教え」の回答画像5](http://oshiete.xgoo.jp/_/bucket/oshietegoo/images/media/8/1138040_59407d5e84701/M.jpg)
No.3
- 回答日時:
一部半角スペースになっていたのを修正
=CHOOSE(LEN(A2),,LEFT(A2,1)&REPT(" ",5)&RIGHT(A2,1),
REPLACE(LEFT(A2,B2),2,0,REPT(" ",B2-1))&REPT(" ",3)&REPLACE(RIGHT(A2,3-B2),2,0,REPT(" ",2-B2)),
IF(MOD(B2,2),LEFT(A2,B2)&REPT(" ",3)&RIGHT(A2,4-B2),
REPLACE(LEFT(A2,2),2,0," ")&" "&REPLACE(RIGHT(A2,2),2,0," ")),
IF(OR(B2=1,B2=4),LEFT(A2,B2)&REPT(" ",2)&RIGHT(A2,5-B2),
REPLACE(LEFT(A2,B2),2,0,REPT(" ",3-B2))&" "&REPLACE(RIGHT(A2,5-B2),2,0,REPT(" ",B2-2))),
LEFT(A2,B2)&" "&RIGHT(A2,6-B2),A2)
No.2
- 回答日時:
長いです。
文字数で分岐、B列名字の文字数(2文字と7文字の場合はいらないけど)=CHOOSE(LEN(A2),,LEFT(A2,1)&REPT(" ",5)&RIGHT(A2,1),
REPLACE(LEFT(A2,B2),2,0,REPT(" ",B2-1))&REPT(" ",3)&REPLACE(RIGHT(A2,3-B2),2,0,REPT(" ",2-B2)),
IF(MOD(B2,2),LEFT(A2,B2)&REPT(" ",3)&RIGHT(A2,4-B2),
REPLACE(LEFT(A2,2),2,0," ")&" "&REPLACE(RIGHT(A2,2),2,0," ")),
IF(OR(B2=1,B2=4),LEFT(A2,B2)&REPT(" ",2)&RIGHT(A2,5-B2),
REPLACE(LEFT(A2,B2),2,0,REPT(" ",3-B2))&" "&REPLACE(RIGHT(A2,5-B2),2,0,REPT(" ",B2-2))),
LEFT(A2,B2)&" "&RIGHT(A2,6-B2),A2)
![「Excelで名前の7文字組みの方法を教え」の回答画像2](http://oshiete.xgoo.jp/_/bucket/oshietegoo/images/media/a/655143_593f9878ac1da/M.png)
No.1
- 回答日時:
「金田一太郎」…さて、このかたは「かねだ いちたろう」さんでしょうか、「きんだいち たろう」さんでしょうか。
どこで区切るかを細かく指定する非常に大きなデータベースを抱えたプログラムになるので、
現状のやり方で良いと思います。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- 政治 次の愛国心あった田中派・経世会と売国心しかない清和会の全く真逆の違いをどう思いまっか? 1 2023/05/28 20:38
- 政治 誰推しですか?東大率高めですけど 岸田文雄→早稲田大学法学部 山口那津男→東京大学法学部 泉健太→立 4 2022/07/04 03:14
- その他(悩み相談・人生相談) 【「期待できない」党首ランキングは?】 1 2022/11/23 13:43
- Access(アクセス) アクセスで教えてください。 例えばテーブル1に 1 佐藤 2 鈴木 3 佐々木 コードと住所一覧があ 3 2022/06/11 20:45
- 演歌・歌謡曲 美空ひばり、鶴田浩二、林伊佐雄、東海林太郎、伊藤久男、霧島昇、藤山一郎、灰田勝彦などは軍歌の歌い手と 10 2023/06/07 16:19
- Excel(エクセル) エクセルの参照について教えてください 1 2022/12/08 16:06
- Excel(エクセル) エクセル 関数 指定の繰り返しの回数 以降(以前)を削除するには、 2 2022/04/24 10:29
- その他(データベース) 20万行あるデータを動かしたい 2 2023/06/13 15:21
- Excel(エクセル) ランダムに並んだ人の名前から、全種類の人を抜き出す関数 7 2022/07/08 08:06
- 野球 WBC日本代表 [2] 1 2022/06/07 21:52
このQ&Aを見た人はこんなQ&Aも見ています
関連するカテゴリからQ&Aを探す
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
多岐にわたる、は、亘る OR ...
-
「はや」の表記
-
「等々」は「とうとう」「など...
-
「以上」と「超」の意味の違い
-
「一言一句」「一字一句」と「...
-
七面六臂(しちめんろっぴ)に...
-
「拠点」と「拠店」の意味の違...
-
「恩恵にあずかる」は「与る」...
-
経験を活かす?それとも生かす
-
文量は正しい日本語ですか?
-
エクセルで「印」のしるしを書...
-
「できるか、できないか」を熟...
-
出費多難と出費多端
-
「世界を周る」のまわるの漢字...
-
図る?計る?測る?量る?諮る...
-
合意の上・下の使い分け
-
同士か同志か
-
勝負の綾の正確な意味
-
参考文献の中には辞書や文法書...
-
ラテン語で「繋ぐ」をおしえて...
おすすめ情報