[[20080418153846]]　『フリガナの表示』（西区）　ページの最後に飛ぶ

 『フリガナの表示』（西区）

 以前，下記のようなコードを教えていただきまして，A1，A2，A3セルのデータを
 A2セルに合体することを教えていただきました。

 Sub 合体()
 Dim x(2) As String
 x(0) = Range("A1").Value
 x(1) = Range("A2").Value
 x(2) = Range("A3").Value
 Range("A1:A3").ClearContents
 Range("A2").Value = Join(x, "")
 End Sub

 それでB2セルに「=PHONETIC(A2)」と設定して，A2セルのデータのフリガナが表示される
 ようにします。
 そして，A1，A2，A3セルに東京，大阪，名古屋と入力すると，まず，B2セルに「オオサカ」
 とA2セルのフリガナが表示されます。
 しかし，上記マクロを実行すると，A2セルは「東京大阪名古屋」と合体して表示されますが
 B2セルも「東京大阪名古屋」と漢字に変わってしまいます。
 これを「トウキョウオオサカナゴヤ」とフリガナが表示されるようにしたいのですが
 どうしたらいいのでしょうか。

 もっといい方法があるかもしれませんが、
 知恵のない方法で･･･ ^^;

 Sub 合体()
 Dim x(2) As String, y(2) As String
 x(0) = Range("A1").Value
 x(1) = Range("A2").Value
 x(2) = Range("A3").Value
 With Application.WorksheetFunction
 y(0) = .Phonetic(Range("A1"))
 y(1) = .Phonetic(Range("A2"))
 y(2) = .Phonetic(Range("A3"))
 End With
 Range("A1:A3").ClearContents
 Range("A2").Value = Join(x, "")
 Range("b2").Value = Join(y, "")
 End Sub

 (1or8)

 Sub 合体()
 Dim Phons
 Dim Phn
 Dim x(2) As String

     x(0) = Range("A1").Value
     x(1) = Range("A2").Value
     x(2) = Range("A3").Value

     For Each Phn In Range("A1:A3").Phonetics
        Phons = Phons & Phn.Text
     Next

     Range("A1:A3").ClearContents

     With Range("A2")
        .Value = Join(x, "")
        .Phonetic.Text = Phons
     End With

 End Sub

 （半平太）

 分かりました。
 どうもありがとうございました。

 （西区）

 すみません，また教えてください。
 上記の半平太先生のコードで
 A1に「東京」，A2に「大阪　京都」（間に全角スペース入り），A3に「名古屋」と入力して
 マクロ実行すると，A2セルには「東京大阪　京都名古屋」となって，間に全角スペースが入りますが，
 B2のフリガナの欄は「トウキョウオオサカキョウトナゴヤ」となって，
 間に全角スペースが入らず，全部くっついてしまいます。
 これをA2セルと同じように，「トウキョウオオサカ　キョウトナゴヤ」と表示させるように
 したいのですが，どうしたらいいのでしょうか。

 （西区）

 かような事でっか？
 　　　　　（弥太郎）
 '-----------------------
 Sub 合体2()
 Dim c As Range, data As String
    For Each c In Range("A1:A3")
        data = data & c
    Next
    Range("a1:a3").ClearContents
    Range("a2") = data
    Range("a2").SetPhonetic
 End Sub

 > 上記の半平太さんのコード
 > 間に全角スペースが入らず，全部くっついてしまいます。

 本当ですね！　そんな仕様になっているの知らなかったです。　(^^ゞ
 ・・となると、 (1or8)さんのが確実ですね。

 あれ、弥太郎さんの案がスマートですね。
 SetPhonetic がワークするならそちらをご採用ください。

 私の苦し紛れ案 (直前のStart位置と文字数を判断してスペースを入れる)
 ↓
 Sub 合体()
 Dim Phons
 Dim Phn As Phonetics
 Dim x

 Dim ZStrt As Long, Zlen As Long

  x = WorksheetFunction.Transpose(Range("A1:A3").Value)

     For Each Phn In Range("A1:A3").Phonetics
        Phons = Phons & Space(IIf(Phn.Start > 1, Phn.Start - ZStrt - Zlen, 0)) & Phn.Text
        ZStrt = Phn.Start
        Zlen = Phn.Length
     Next

     Range("A1:A3").ClearContents

     Range("A2").Value = Join(x, "")
     Range("A2").Phonetic.Text = Phons

 End Sub

 弥太郎先生のコードで試してみましたが，また問題が発生しました。

 Sub 合体2()
 Dim c As Range, data As String
    For Each c In Range("A1:A3")
        data = data & c
    Next
    Range("a1:a3").ClearContents
    Range("a2") = data
    Range("a2").SetPhonetic

    For Each c In Range("A4:A6")
        data = data & c
    Next
    Range("a4:a6").ClearContents
    Range("a5") = data
    Range("a5").SetPhonetic

 End Sub

 として，下段にもう１組続くように設定して，たとえば
 A1に「あ」，A2に「い　う」，A3に「え」
 A4に「お」，A5に「か　き」，A6に「く」
 と入力すると

 A2は「あい　うえ」，B2はフリガナで「アイ　ウエ」となりますが
 A5は「あい　うえおか　きく」，B5は「アイ　ウエオカ　キク」
 となってしまうので，２組目もきちんと
 「おか　きく」「オカ　キク」
 と表示させるにはどうしたらいいでしょうか。

 （西区）

 問題発生は、問題発生するべくして起こります。
 data=data & c というのは 変数dataにcを付け加えなさいっちゅうことですワ。
 ですから一回目に使うたdataは2回目使う前に初期化しとかなあきまへん。
 For　Eacn ・・・・の一行前にdata=""を追加しませう。
  　　　　　　　（弥太郎）

 できました
 どうもありがとうございました。

 （西区）

コメント返信：

[ 一覧(最新更新順) ]

[[20080418153846]] 『フリガナの表示』（西区） ページの最後に飛ぶ

[[20080418153846]]　『フリガナの表示』（西区）　ページの最後に飛ぶ