[[20091230064848]]　『フリガナの編集』（Ty）　ページの最後に飛ぶ

『フリガナの編集』（Ty）

     A      B
 1、11     音　　　←おと
 2、12　　 音　　　←おん
 3、13     音　　　←ね

 の時に下記マクロを実行したf8、f9、f10のフリガナを編集したい

 Sub test()
 Range("f8") = Application.VLookup(Range("D8"), Range("$A$1:$B$3"), 2, 0)
 Range("f9") = Application.VLookup(Range("D9"), Range("$A$1:$B$3"), 2, 0)
 Range("f10") = Application.VLookup(Range("D10"), Range("$A$1:$B$3"), 2, 0)
 Range("f8:f10").SetPhonetic
 Range("F8:f10").Select
 Selection.Phonetics.Visible = True
 End Sub

     F
 8、音　　　←おと→おと
 9、音　　　←おと→おん
 10、音　　　←おと→ね

 ご教示ください。
 (Ty)

 新規ブックにて以下のコードを試してみてください。

 '==============================================================================
 Sub test()
    Dim rw As Long
    Dim g0 As Long
    Dim g1 As Long
    Dim rnga As Range
    Dim rngb As Range
    Dim crng As Range
    Cells.ClearContents
    Set rnga = Range("a1:a3")
    For g0 = 1 To rnga.Count
        With rnga(g0)
           .Value = g0 + 10
           With .Offset(0, 1)
              .Value = "音"
              .Phonetics.Delete
              .Phonetic.Text = Array("オト", "オン", "ネ")(g0 - 1)
           End With
        End With
    Next
    With Range("d8:d10")
       .Formula = "=row()+3"
       .Value = .Value
    End With
    MsgBox "この表示されているデータに対して、マクロを実行します"
    Set rngb = Range("f8:f10")
    For g0 = 1 To rngb.Count
       rw = Application.Match(rngb(g0).Offset(0, -2), rnga, 0)
       With rngb(g0)
          .Value = rnga(rw).Offset(0, 1).Value
          .Phonetics.Delete
          Set crng = rnga(rw).Offset(0, 1)
          On Error Resume Next
          For g1 = 1 To crng.Phonetics.Count
              Err.Clear
             .Phonetics.Add crng.Phonetics(g1).Start, crng.Phonetics(g1).Length, crng.Phonetics(g1).Text
             If Err.Number <> 0 Then
                .Phonetic.Text = crng.Phonetic.Text
                Exit For
             End If
          Next
          On Error GoTo 0
       End With
    Next
    rngb.Phonetics.Visible = True
 End Sub

 フリガナは、オブジェクトとして存在しているので本当にコピーするのは、もっと大変なのですが、
 取りあえず、フリガナ（読み）のコピーだけです。

 何も入力されていないシートをアクティブにして上記testを実行してください

 ichinose

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

コメント返信：

[ 一覧(最新更新順) ]

[[20091230064848]] 『フリガナの編集』（Ty） ページの最後に飛ぶ

[[20091230064848]]　『フリガナの編集』（Ty）　ページの最後に飛ぶ