別シートに入力されているフリガナをVBAで設定

お世話になっております。
勤務管理表で従業員のフリガナを設定するVBAプログラムで私はRange+PhoneticCharactersを使って設定し入力をしているのですが、これを別シートに入力されているフリガナをセルに入力させるにはどの様なプログラムになるのでしょうか？
下記に例を記述致します。
sheet1のC5に島村さん、C6に小川さん。
sheet2のB2セルにシマムラ。C6にオガワと入力されております。

よろしくお願い致します。

No.2 ベストアンサー 回答者： WindFaller 回答日時： 2017/06/22 09:30

少し、よくわからない部分があります。

それは、Sheet1 の漢字の氏名は、フリガナ・データが封入されていないということでしょうか？これは、テキスト等のコピー＆ペーストですと、Rangeオブジェクトには入っておりません。

通常、フリガナデータのない漢字データに、フリガナを入れるコマンドは、
Ctrl + Alt + ↑　で復活します。
それをマクロで一括していれる方法もあります。TestSample3

#1のお礼欄からの私の解釈からすると、このようなコードかと思います。

'//標準モジュール
Sub TestMacro2()
Dim sh2 As Worksheet
Dim i As Long, c As Variant
Dim Furi As String
Set sh2 = Worksheets("Sheet2")
i = 2
With Worksheets("Sheet1")
For Each c In .Range("C5", .Cells(Rows.Count, 3).End(xlUp))
If c.Value <> "" Then
　Furi = sh2.Cells(i, "B").Value
　If Furi <> "" Then
　　c.Phonetics(1).Text = Furi
　End If
End If
i = i + 1
Next
End With
End Sub

'//以下は正確さに欠けます。IMEの辞書を利用しているに過ぎません。

Sub TestMacro3()
With Worksheets("Sheet1")
　　.Range("C5", .Cells(Rows.Count, 3).End(xlUp)).SetPhonetic
End With
End Sub

この回答へのお礼

WindFalle様ありがとうございます！
TestMacro2が私の理想としていたプログラムになります。
活用させていただきます。

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

お礼日時：2017/06/22 16:00

No.1 回答者： WindFaller 回答日時： 2017/06/21 08:04

Sheet2 の同じセル番地なら以下のようにすれば可能ですが、

>sheet2のB2セルにシマムラ,C6にオガワ
のように、規則性がない場合は、基本的に部分は変わりませんが、全体的なコードは変わってくる可能性が高いです。また、　If Furi <> "" Then　で取れない場合も、コードが変わります。

'//
Sub TestMacro1()
Dim sh2 As Worksheet
Dim i As Long
Dim Furi As String
Set sh2 = Worksheets("Sheet2")

With Worksheets("Sheet1")
For i = 1 To Cells(Rows.Count, 3).End(xlUp).Row
If .Cells(i, 3).Value <> "" Then
　Furi = .Cells(i, 3).Phonetics(1).Text '*
　If Furi <> "" Then
　　sh2.Cells(i, 3).Value = Furi
　End If
End If
Next
End With
End Sub

この回答へのお礼

WindFaller様回答ありがとうございます！
申し訳ございません。
私の説明不足な質問で内容が上手く伝わっておりませんでした。
sheet1のC5セル、C6セルに氏名の漢字が入力されております。
島村、小川、下に20人ほどおります。
別シートのsheet2のB2セル、シマムラ、B3セル、オガワ、下にそれぞれフリガナが入力されており、このセルからsheet1のC5セルから下にフリガナを反映させたい内容になります。
また最初の質問のsheet2のC6セルにオガワと入力されておりますの部分が間違っていましたので誠に申し訳ございません。

上記のVBAのプログラムはどの様になりますでしょうか？

よろしくお願い致します。

お礼日時：2017/06/22 02:37