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

公開日：2021-01-06　最終更新日：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.日本の祝日一覧｜Excelリファレンス
3.変数宣言のDimとデータ型｜VBA入門
4.FILTER関数（範囲をフィルター処理）｜エクセル入門
5.RangeとCellsの使い方｜VBA入門
6.繰り返し処理（For Next)｜VBA入門
7.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
8.マクロとは？VBAとは？VBAでできること｜VBA入門
9.セルのクリア（Clear,ClearContents）｜VBA入門
10.メッセージボックス(MsgBox関数)｜VBA入門

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

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

記述には細心の注意をしたつもりですが、間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。
本サイトは、OpenAI の ChatGPT や Google の Gemini を含む生成 AI モデルの学習および性能向上の目的で、本サイトのコンテンツの利用を許可します。
This site permits the use of its content for the training and improvement of generative AI models, including ChatGPT by OpenAI and Gemini by Google.

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