Excelデータで名前をスペースで入れて7文字組みに変換させたいのですが、
関数またはVBAなどの方法を教えていただけませんでしょうか?
今は関数で個別でMID関数を使い分けてしています。

例) 
林一    → 林     一     田中一   → 田 中   一
林太郎   → 林   太 郎     田中太郎  → 田 中 太 郎
林孝太郎  → 林   孝太郎     田中孝太郎 → 田 中 孝太郎

佐々木一  → 佐々木   一
佐々木太郎 → 佐々木 太 郎
佐々木孝太郎→ 佐々木 孝太郎

A 回答 (5件)

板汚しすみません。

まだ半角スペース残ってた
=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)
    • good
    • 1
この回答へのお礼

出来れば関数の内容などを教えていただけると助かります^^

お礼日時:2017/06/14 15:25

こんにちは。



とても気になった質問なので、私も本格的に試してみました。
なかなか手間の掛かる準備が必要です。

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
    • good
    • 1

一部半角スペースになっていたのを修正


=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)
    • good
    • 0

長いです。

文字数で分岐、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
    • good
    • 0

「金田一太郎」…さて、このかたは「かねだ いちたろう」さんでしょうか、「きんだいち たろう」さんでしょうか。



どこで区切るかを細かく指定する非常に大きなデータベースを抱えたプログラムになるので、
現状のやり方で良いと思います。
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング

おすすめ情報