エクセル・１つのセルに入った漢字（カナ）の分け方

質問

エクセルにお強い方、教えてください＞＜

A1のセルに、
山田　花子（ヤマダ　ハナコ）
とあるとします。

私は
B１のセルに
山田　花子
C1のセルに
（ヤマダ　ハナコ）
と、分けてデータ化させたいのですが、
どのようにマクロを組めばよいでしょうか？

また、分け終わったC１の（ヤマダ　ハナコ）に
置換を使って（　）をとって、
カナ を かな に直すため、
PHONETICと書式のふりがな機能を使って直しても
データにエラーは起きずに処理できるでしょうか？

最終的なデータとして
A1セル→山田　花子（やまだ　はなこ）
B1セル→山田　花子
C1セル→やまだ　はなこ
としたいのです。

ご存知の方いらっしゃいましたら、教えてください。
宜しくお願い致します。

回答No.5

tom04 · ベストアンサー

No.3です！
たびたびごめんなさい。
C列がカタカナの場合はひらがなに直さないといけなかったのですね？

もう一度コードを載せておきます。

Sub test()
Dim i As Long
Dim buf As String
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
On Error Resume Next
buf = WorksheetFunction.Substitute(WorksheetFunction.Substitute _
(Cells(i, 1), "（", "("), "）", ")")
With Cells(i, 2)
.Value = Mid(buf, 1, WorksheetFunction.Find("(", buf) - 1)
.Offset(, 1) = Mid(buf, WorksheetFunction.Find _
("(", buf) + 1, Len(buf) - Len(Cells(i, 2)) - 2)
.Offset(, 2) = StrConv(Cells(i, 3), vbHiragana)
End With
Next i
Columns(3).Delete (xlToLeft)
Columns("A:C").AutoFit
End Sub

こんな感じではどうでしょうか？
何度も失礼しました。m(__)m

お礼

丁寧なご説明ありがとうございました

回答No.8

layy

＞最終的なデータとして
＞A1セル→山田　花子（やまだ　はなこ）

編集元のＡ列「山田　花子（ヤマダ　ハナコ）」も上書き修正したいですか？

Ｂ列とＣ列ができた後で連結でもいいのでは？。

お礼

ありがとうございました

回答No.7

imogasi

A1に山田花子とありＢ列に=A1&"("&PHONETIC(A1)&")"と入って、山田　花子(ヤマダ　ハナコ)となっているので「ない」場合を考える。こういう場合もあるということ。
ーー
?１に山田　花子(ヤマダ　ハナコ)とある場合は、データー区切り位置ーその他で(　左カッコ　を指定ー完了
で出来る。
）は置換で抹消する。
これが一番簡単で安定。さらにＢ列で）で区切り位置にしても良い。
マクロの記録をすれば、ＶＢＡコードはわかる。
複数行分もはじめ範囲指定して始めれば良い。
ーー
ＶＢＡでＲｅｐｌａｓｅやＩｎｓｔｒ関数でやる手もあるが、関数などでやるのが良かろう。ＶＢＡの勉強をしているのですか。
１回限りの作業のようだし、ＶＢＡを使うまでも無いだろう。
エクセルに強い方でなくても出来ることだ。

お礼

ありがとうございました

回答No.6

layy

『山田　花子（ヤマダ　ハナコ）』

ＶＢＡでは
この文字数分（＝１４）ループしてもできる話です。
区切り分けたり、（括弧）を削除したり、かなに変えたり、
とすべてを処理しながらＢ列やＣ列の編集をする。

お礼

ありがとうございました

回答No.4

kmetu

追加です

"（"

の部分の「（」の半角と全角を間違うとエラーになります。

お礼

ありがとうございました

回答No.3

tom04

こんばんは！
関数の方が簡単なような気がしますが、VBAをご希望のようなので・・・
一例です。
（単に関数でやる方法をコードにしただけです）
A列のデータは1行目からあり、必ず（　）があるという前提です。

Sub test()
Dim i As Long
Dim buf As String
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
On Error Resume Next
buf = WorksheetFunction.Substitute(WorksheetFunction.Substitute _
(Cells(i, 1), "（", "("), "）", ")")
With Cells(i, 2)
.Value = Mid(buf, 1, WorksheetFunction.Find("(", buf) - 1)
.Offset(, 1) = Mid(buf, WorksheetFunction.Find _
("(", buf) + 1, Len(buf) - Len(Cells(i, 2)) - 2)
End With
Next i
Columns("A:C").AutoFit
End Sub

こんな感じではどうでしょうか？m(__)m

お礼

ありがとうございました

回答No.2

kmetu

B1に
=LEFT(A1,FIND("（",A1)-1)
で山田　花子が

C1に
=MID(A1,FIND("（",A1)+1,LEN(A1)-LEN(B1)-2)
でヤマダ　ハナコが

それぞれ取り出せます

取り出した後にコピー形式を選択して貼り付けで「値」を貼り付けて
その後PHONETICと書式のふりがな機能を使って直しください。

お礼

ありがとうございました

回答No.1

keithin

Sub Macro1()
　Dim r As Long
　r = Range("A65536").End(xlUp).Row
　Range("A1:A" & r).Replace what:=")", replacement:="", matchbyte:=False
　Range("A1:A" & r).Replace what:="（", replacement:="(", matchbyte:=False
　Range("A1:A" & r).TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
　　Other:=True, OtherChar:="(", FieldInfo:=Array(Array(1, 1), Array(2, 1))
　Range("B:B").Phonetics.CharacterType = xlHiragana
　Range("C1:C" & r).Formula = "=PHONETIC(B1)"
　Range("A:A").Insert
　Range("A1:A" & r).Formula = "=B1&""(""&D1&"")"""
　Range("A1:D" & r).Value = Range("A1:D" & r).Value
　Range("C:C").Delete
　Range("A:C").EntireColumn.AutoFit
End Sub

＃要らないループ処理は省いているので，見た目なんだかべたべたですね。

お礼

ありがとうございました