VBAで読み仮名をひらがなで入力する

Question

実現したいこと

ボタンクリックで以下の表のようにA列をセルが空白のときにひらがなで挿入される機能を作成。

例
【1】

	A	B	C
1	いろはにおえどちりぬるを	イロハニオエドチリヌルヲ	色は匂えど散りぬるを
2	イロハニオエ	色は匂え
3	つきにむらくもはなにかぜ	ツキニムラクモハナニカゼ	月に叢雲華に風
4	つきにむら	ツキニクサムラ	月に叢

↓

【2】- ボタンクリック後に実現したいもの

	A	B	C
1	いろはにおえどちりぬるを	イロハニオエドチリヌルヲ	色は匂えど散りぬるを
2	いろはにおえ	イロハニオエ	色は匂え
3	つきにむらくもはなにかぜ	ツキニムラクモハナニカゼ	月に叢雲華に風
4	つきにむら	ツキニクサムラ	月に叢

備考

• 【1】にてA列になにも入っていない場合は条件(ソースコード参照)を満たす限りB列の内容通りにA列にひらがなでの読み仮名を挿入する
• 【1】のB4は直接修正、【1】で文字列が挿入されていたことにより【2】で読み仮名(ひらがな)を挿入しない
• 【1】のA2が空白だったことにより、【2】でひらがなが挿入される
• B列は[GetPhoneticf]で片仮名のフリガナを表示

前提

C列にルビをふって出力する方法は不可

発生している問題

以下のように、A4がボタンクリック時に反映されてしまう

【2】- 現状

	A	B	C
1	いろはにおえどちりぬるを	イロハニオエドチリヌルヲ	色は匂えど散りぬるを
2	いろはにおえ	イロハニオエ	色は匂え
3	つきにむらくもはなにかぜ	ツキニムラクモハナニカゼ	月に叢雲華に風
4	つきにくさむら	ツキニクサムラ	月に叢

該当のソースコード

Sub ConvertHiragana()

    Dim i As Integer
    i = 1
   
        'ループ開始
        Do
            
            '空白箇所は記入する
            If Cells(i, 1) = "" Then
                'ひらがなに変更する
                Worksheets("記入箇所").Cells(i, 1) = StrConv(Worksheets("記入箇所").Cells(i, 2), vbHiragana)
            End If
            
            '下のセルを参照させ、確認する
            i = i + 1
            
            'iの下が空白のとき終了する
            If Worksheets("記入箇所").Cells(i, 2) = "" Then
                Exit Do
            End If
        
        Loop

End Sub

備考

• セル[i,2]の2つ以上下のセルに値が入る状況はありません

試したこと

上記コードをデバック(ステップインで実施)したところ[実現したいころ]同様に正常に動作したが、ボタンで動作させると[発生している問題の状態]になる。

補足情報（FW/ツールのバージョンなど）

Excel 2019
標準モジュールに記述

Comments

[itagagaki]

Excel 2013 で提示のコードを試しましたが問題は再現しませんでした。

Answer 1

Sub ConvertHiragana()

    Dim i As Integer
    i = 1

        'ループ開始
        Do

            '空白箇所は記入する
            If Worksheets("記入箇所").Cells(i, 1) = "" Then
                'ひらがなに変更する
                Worksheets("記入箇所").Cells(i, 1) = StrConv(Worksheets("記入箇所").Cells(i, 2), vbHiragana)
            End If

            '下のセルを参照させ、確認する
            i = i + 1

            'iの下が空白のとき終了する
            If Worksheets("記入箇所").Cells(i, 2) = "" Then
                Exit Do
            End If

        Loop

End Sub