[[20100418093301]]　『フリガナがない人にフリガナを』（アレカヤシ）　ページの最後に飛ぶ

『フリガナがない人にフリガナを』（アレカヤシ）

windowsXP Excel2003使用しています。

A列に漢字氏名がありB列にそのフリガナがある人とない人があります。

フリガナのない人のみフリガナを表示しセルに色をつけるマクロを教えてください。

フリガナは半角カタカナで表示したいです。

よろしくお願いします。

 Sub samp1()
    Dim crng As Range
    Dim trng As Range
    Set crng = Nothing
    With Range("a2", Cells(Rows.Count, "a").End(xlUp))
       If .Row > 1 Then

          For Each trng In .Cells
             With trng
                If .Phonetics.Count = 0 Then
                   .Interior.ColorIndex = 3
                   If crng Is Nothing Then
                      Set crng = .Cells
                   Else
                      Set crng = Union(crng, .Cells)
                   End If
                Else
                   .Interior.ColorIndex = xlNone
                End If
             End With
          Next
       End If
    End With
    If Not crng Is Nothing Then
       With crng
          .SetPhonetic
          .Phonetics.CharacterType = xlKatakanaHalf
       End With
    End If
 End Sub

 但し、Ａ列１行目は、項目名だとします。
 又、フリガナは、正しいフリガナでないときもありますよ、

 ichinose

ichinose様　

 ありがとうございます。
 マクロを実行してもフリガナガが表示されないのですが。
 また、フリガナがある人のセルにも色がついてしまいます。
 申し訳ありませんがご指導お願いいたします。　　
 アレカヤシ

ichinose様　

 説明不足で申し訳ありません。
 フリガナはＡ列の漢字氏名のとなり（Ｂ列）に表示したいです。
 また、セルの色は、フリガナがなっかた漢字氏名と新しく振られたフリガナ両方に
 色をつけたいです。
 よろしくお願いいたします。
 アレカヤシ

 こんにちわ。。
 ちょっと、不細工かな？
 Sub TEST()
    Dim myRng As Range
    Dim c As Range

    Set myRng = Range(Range("A1"), Cells(Rows.Count, "A").End(xlUp))
    For Each c In myRng
        If c.Offset(, 1).Value = "" Then
            c.Offset(, 1).Value = StrConv(Application.GetPhonetic(c.Value), 16 + 8)
            c.Resize(, 2).Interior.ColorIndex = 3
        End If
    Next
End Sub
 (kei)

 あら、仕様を間違えていましたか？

 Sub samp1()
    Dim crng As Range
    Dim rng As Range
    Dim trng As Range
    Set crng = Nothing
    With Range("a2", Cells(Rows.Count, "a").End(xlUp))
       If .Row > 1 Then
          For Each trng In .Cells
             With trng
                If .Phonetics.Count = 0 Or .Offset(0, 1).Value = "" Then
                   If crng Is Nothing Then
                      Set crng = .Cells
                   Else
                      Set crng = Union(crng, .Cells)
                   End If
                Else
                   .Resize(, 2).Interior.ColorIndex = xlNone
                End If
             End With
          Next
       End If
    End With
    If Not crng Is Nothing Then
       With crng
          .SetPhonetic
          .Phonetics.CharacterType = xlKatakanaHalf
          For Each rng In .Areas
             rng.Resize(, 2).Interior.ColorIndex = 3
             With rng.Offset(0, 1)
                .Formula = "=phonetic(rc[-1])"
                .Value = .Value
             End With
          Next
       End With
    End If
 End Sub

 Ａ列の漢字は、全部フリガナが設定されているという設定ならば、
 もう少し簡単になるかもしれませんが、Ａ列の漢字にフリガナが設定されていなければ、
 フリガナを設定し、Ｂ列にそのフリガナを表示するという仕様にしました。

 ichinose

ichinose様　kei様

 ありがとうございます。
 イメージどおりです。たすかりました。

kei様

 参考までにコード中の16 + 8は半角カタカナを意味するのでしょうか。
 また、どのように決まるのでしょうか。
 お時間ありましたらご返答ください。
 アレカヤシ

 Visual Basic Editor　で表示＞オブジェクトブラウザを選択、
StrConvを検索（双眼鏡のアイコンの左にStrConvを入力して双眼鏡アイコンクリック）
すると、「クラス」にvbStrConvという項目が現れるのでそれをクリック。
vbStrConvのメンバというのが表示されます。
それぞれクリックしてみると、
Const vbNarrow = 8 とか表示されます。「名前付き組込定数」というやつです。
16はvbKatakanaであるのも解ると思います。
16 + 8　は　 StrConv　関数の引数に、[vbKatakana　と　vbNarrow]を指定したのと
同じなのですが、数値にしてしまうと後でわかりにくいので、私は極力、
名前付き引数を使うようにしています。
　
(みやほりん)(-_∂)b

(みやほりん)(-_∂)b様

 ご丁寧な説明感謝いたします。
 [16 + 8] を　[vbKatakana　+　vbNarrow]　と置き換えて実行してみました。
 少しずつマクロを勉強していきたいと思います。
 ありがとうございました。
 アレカヤシ

 (みやほりん)(-_∂)bさん、丁寧な解説ありがとうございました。m(__)m
 (kei)

コメント返信：

[ 一覧(最新更新順) ]

[[20100418093301]] 『フリガナがない人にフリガナを』（アレカヤシ） ページの最後に飛ぶ

[[20100418093301]]　『フリガナがない人にフリガナを』（アレカヤシ）　ページの最後に飛ぶ