VBA100本ノック 61本目：「ふりがな」の取得と設定

最終更新日：2021-03-22

VBA100本ノック 61本目：「ふりがな」の取得と設定

「ふりがな」の取得と「ふりがな」を設定する問題です。

ツイッター連動企画です。
ツイートでの見やすさを考慮して、ブック・シート指定等を適宜省略しています。

VBAテスト用のサンプルデータは、VBA100本ノックの目次ページ からもダウンロードできます。

マクロVBAを初心者向けの基本から上級者向けの高度な内容までサンプルコードを掲載し解説しています。エクセル関数・機能・基本操作の入門解説からマクロVBAまでエクセル全般を網羅しています。

出題

#VBA100本ノック 61本目
A列の名称には「ふりがな」が正しく入っていません。
「マスタ」シートのA列には「ふりがな」が正しく設定されているので、ここから「ふりがな」を取得しA列に「ふりがな」を設定してください。
マスタなしは赤文字にしてください。（既定の文字色は自動）
※シートは任意

サンプルファイルです。
https://excel-ubara.com/vba100sample/VBA100_61.xlsm
https://excel-ubara.com/vba100sample/VBA100_61.zip

VBA作成タイム

この下に頂いた回答へのリンクと解説を掲載しています。
途中まででも良いので、できるだけ自分でVBAを書いてみましょう。

他の人の回答および解説を見て、書いたVBAを見直してみましょう。

頂いた回答

出題ツイートの引用ツイートでの回答

解説

「マスタ」の行を特定するにはシート関数のMatchを使うのが簡単だと思います。
ただし、存在しない場合のエラー対策が必要です。
「ふりがな」の設定は、簡単な方法としてRangeのPhoneticオブジェクトのTextで設定してみます。
この場合は、「カナ」や「かな」にも「ふりがな」が設定されます。


  
    
      Sub VBA100_61_01()

　　Dim ws As Worksheet, mst As Range

　　Set ws = Worksheets("data")

　　Set mst = Worksheets("マスタ").Columns(1)

　　

　　Application.ScreenUpdating = False

　　On Error Resume Next

　　ws.Columns(1).Font.Color = False

　　

　　Dim i As Long, ix As Long

　　For i = 2 To ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

　　　　ws.Cells(i, 1).Phonetic.Visible = True

　　　　ix = 0

　　　　ix = WorksheetFunction.Match(ws.Cells(i, 1), mst, 0)

　　　　If ix = 0 Then

　　　　　　ws.Cells(i, 1).Font.Color = vbRed

　　　　Else

      　　　　　　ws.Cells(i, 1).Phonetic.Text = mst.Cells(ix).Phonetic.Text

　　　　End If

      　　Next

End Sub

「マスタ」と全く同じように「ふりがな」を設定するには、Phoneticsオブジェクトを操作します。
または、「2本目：セルのコピー」で解説したようにPasteSpecialのxlPasteValuesでコピーする方法もあります。

・出題・頂いた回答・解説・補足・サイト内関連ページ

これらについては記事補足に掲載しました。

補足

Phoneticsオブジェクト

「ふりがな」は、RangeオブジェクトのPhoneticsオブジェクトに入っています。

Office VBA Reference の Phonetics object

ここでは、「Phoneticオブジェクトのコレクション」との説明になっていますが、少々正確ではないようです。
Phoneticsコレクションに入っているのはPhoneticsオブジェクトになっています。

「RangeオブジェクトのPhoneticプロパティは、Microsoft Excel の以前のバージョンとの互換性を提供します。」
という事のようです。

「ふりがな」は、いくつかに分割されています。
IMEで変換単位にオブジェクトが分かれています。

IMEでの入力単位の「ふりがな」がPhoneticsオブジェクトに入っていて、そのコレクションもPhoneticsになります。
「ニホン」 → Phonetics(1) ・・・ Phoneticsオブジェクト
「カブシキガイシャ」 → Phonetics(2) ・・・ Phoneticsオブジェクト
Phonetics(1)とPhonetics(2)が入っているコレクションもPhoneticsです。


  
    
      Sub VBA100_61_02()

      　　Dim rngMst As Range

      　　Set rngMst = Worksheets("マスタ").Columns(1)

      　　

      　　Dim rngIn As Range

      　　Set rngIn = Worksheets("data").Range("A1").CurrentRegion.Resize(, 1)

      　　Set rngIn = Intersect(rngIn, rngIn.Offset(1))

      　　rngIn.Font.ColorIndex = xlAutomatic

      　　rngIn.Phonetic.Visible = True

      　　

      　　Application.ScreenUpdating = False

      　　On Error Resume Next

      　　

      　　Dim rng As Range, ph As Phonetics, ix As Long

      　　For Each rng In rngIn

      　　　　Err.Clear

      　　　　ix = WorksheetFunction.Match(rng, rngMst, 0)

      　　　　If Err Then

      　　　　　　rng.Font.Color = vbRed

      　　　　Else

      　　　　　　rng.Phonetics.Delete

      　　　　　　For Each ph In rngMst.Cells(ix).Phonetics

      　　　　　　　　rng.Phonetics.Add ph.Start, ph.Length, ph.Text

      　　　　　　Next

      　　　　End If

      　　Next

      End Sub

PasteSpecialのxlPasteValues

「2本目：セルのコピー」ここで解説したようにPasteSpecialのxlPasteValuesでコピーすると「ふりがな」もコピーされます。

・出題・頂いた回答・解説・補足・サイト内関連ページ


  
    
      Sub VBA100_61_03()

　　Dim ws As Worksheet, mst As Range

　　Set ws = Worksheets("data")

　　Set mst = Worksheets("マスタ").Columns(1)

　　

　　Application.ScreenUpdating = False

　　On Error Resume Next

　　ws.Columns(1).Font.Color = False

　　

　　Dim i As Long, ix As Long

　　For i = 2 To ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

　　　　ix = 0

　　　　ix = WorksheetFunction.Match(ws.Cells(i, 1), mst, 0)

　　　　If ix = 0 Then

　　　　　　ws.Cells(i, 1).Font.Color = vbRed

　　　　Else

　　　　　　mst.Cells(ix).Copy

　　　　　　ws.Cells(i, 1).PasteSpecial Paste:=xlPasteValues

　　　　End If

　　Next

　　

　　Application.CutCopyMode = False

End Sub

サイト内関連ページ

今回の出題を考えた時、実はこれらについては解説ページが無い事に気づきました。
かろうじて関連として以下のページがあるだけでした。

第104回．GetPhoneticメソッドとSetPhoneticメソッド（フリガナ）｜VBA入門

・GetPhoneticメソッド・GetPhoneticメソッドの使用例・SetPhoneticメソッド・SetPhoneticメソッドの使用例

ユーザー定義関数でフリガナを取得する（GetPhonetic）｜VBAサンプル

ワークシート関数の、「PHONETIC」では、他のソフト等からコピペした漢字は取得できません。そこで、VBAでユーザー定義関数を作成し、読みを取得できるようにします。A列はメモ帳よりコピペしました。B列に、ユーザー定義関数を指定して、振り仮名を取得しています。

PHONETIC関数（文字列からふりがなを抽出）｜エクセル入門

・PHONETIC関数の書式・範囲・PHONETIC関数の使用例・PHONETIC関数の応用例

同じテーマ「VBA100本ノック」の記事

58本目：番号リストを簡潔にした文字列で返す
 59本目：12ヶ月分のシートを四半期で分割
 60本目：「株式会社」の表記ゆれ置換
61本目：「ふりがな」の取得と設定
62本目：独自のZLOOKUP関数を作成
 63本目：複数シートの連結
 64本目：リンクされた図（カメラ機能）
65本目：固定長テキスト出力
 66本目：全サブフォルダからファイルを探す
 67本目：ComboBoxとListBox
68本目：全テキストボックスの転記

アクセスランキング・・・ランキング一覧を見る

1.最終行の取得（End,Rows.Count）｜VBA入門
2.RangeとCellsの使い方｜VBA入門
3.繰り返し処理（For Next)｜VBA入門
4.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
5.変数宣言のDimとデータ型｜VBA入門
6.マクロとは？VBAとは？VBAでできること｜VBA入門
7.ブックを閉じる・保存（Close,Save,SaveAs）｜VBA入門
8.条件分岐（IF）｜VBA入門
9.並べ替え（Sort）｜VBA入門
10.Range以外の指定方法（Cells,Rows,Columns）｜VBA入門

ホーム
マクロVBA入門編
VBA100本ノック
61本目：「ふりがな」の取得と設定

このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。

記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。

VBA練習問題
VBA100本ノック 61本目：「ふりがな」の取得と設定