エクセルのvbaでのふりがなについて…

質問

年賀状のために住所録を作成しているのですが、
住所から簡単に郵便番号を表示できるようにしたいと考えています。
いろいろ調べた結果、アドインのウィザードを使えばできるのは
わかっているのですが…それとは別の方法で
住所を７桁の郵便番号で打ち込み、それを辞書ツールで変換して住所を作り、
その部分の振り仮名をphonetic関数で表示すれば郵便番号が
出力できることがわかりました。

しかし、これを今度vbaのユーザーフォームで入力した場合…
住所の部分をユーザーフォームのテキストボックスで入力し、
その住所の振り仮名を隣のセルに出力させようと思ったのですが、
textbox1 = cell(1,2).value
の形で持ってくるきた上でエクセルのA1セルに
=phonetic(A2)
という表示をつけても振り仮名情報までは維持されないようで
振り仮名が表示できなくなってしまいました。

VBAのテキストボックスの中の文字の振り仮名情報などを
エクセルのセルなどに転用できるような方法などあるのでしょうか？

説明下手ですみません…わかりにくいと書いていただければ
また補足を付け足していこうと思うので…
なにとぞ回答のほどよろしくお願いします。

回答No.3

imogasi · ベストアンサー

PHONETICの仕組みを知らないから、こういう質問になるのだ。
フリガナは、エクセルのシートに向かって仮名漢字変換システムを使って、漢字文字列を入力したときにエクセルは、入力されたカナ・かなをエクセルのシートのセルに覚えるのだ。
セルの属性の１つだが、セルの「値」ではない。
ーー
cell(1,2).valueの.valueは文字通り「セルの値」であって、こんなものを代入しても、フリガナが入るわけが無い。
このことが１つ。
ーー
もうひとつ、エクセルにデータがあっても、VBAで
Cells(1,１)="田中"とすると仮名漢字変換を通っていないので
フリガナ情報はセットされない。
そのほかにも他ソフトからデータをインポートしたり、コピー
したりすると、同じようなことになる。年賀状ソフトには振り仮名の仕組みが無いか、エクセルとは違う点がある方式だから。
ーー
上記の場合でも、別の道で「田中」という漢字から、タナカを割り出す方法がある。
標準的NO1の頻度の読みになってしまう
ーーー
例データA1,B1,C1
田中 田中 タナカ
B1の関数　=PHONETIC(A1)
Å1 の値は下記VBAででセット
C1は下記でセット
B1はタナカにならず、田中であることに注意。
Sub test01()
Cells(1, 1) = "田中"
Cells(1, 3) = Application.GetPhonetic(Range("A1"))
End Sub
GetPhoneticは、Applicationとはエクセルのこと。他のソフトはもちろんVBでは使えないかもしれないので注意。

お礼

ありがとうございます！
始めは=phoneticはカタカナを割り出すものだと思っていたのですが…
変換するときの情報を扱っていたのですね…
Application.GetPhoneticという言葉を使用することで
簡単に処理をすることができました！！
いろいろ解説までしていただきありがとうございます。

回答No.2

Wendy02

こんばんは。

細かなエラー処理はなされていませんが、こういうことでしょうか。
ただし、IMEのバージョンとOffice のバージョンによって動かないことがあります。

TextBox1 に、郵便番号を入れて、Enter を入れるとセルに郵便番号が入り、もう一度Enter を入れると、その変換文字が、右横のセルに入ります。

本来は、検索システムを使って、郵便番号から変換するのが良いのです。WinArrowさんという方が出している郵便番号変換はフリーでは有名です。他は、郵便番号ウィザードから、郵便番号検索エンジンを使えればよいのですが、プロテクトが入っているので使えません。有償のものは高いので、仕事でもなければ買わないです。

'-------------------------------------------
'Option Explicit

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
　　Dim buf As Variant
　　If KeyCode <> 13 Then Exit Sub
　　With Cells(Rows.Count, 1).End(xlUp).Offset(1)
　　　　buf = TextBox1.Value
　　　　If Len(buf) = 8 And IsNumeric(Left(buf, 1)) Then
　　　　　　.Value = buf
　　　　　　ChangeZip .Cells(1)
　　　　　　'変換されなかったときにエラー処理
　　　　　　If Not TextBox1.Value Like "[一-龠]*" Then
　　　　　　　.Value = ""
　　　　　　End If
　　　　Else
　　　　　　If Len(Left(buf, 1)) <> LenB(StrConv(Left(buf, 1), vbFromUnicode)) Then
　　　　　　　　.Offset(-1, 1).Value = TextBox1.Value
　　　　　　End If
　　　　End If
　　End With
　　TextBox1.Value = ""
End Sub
Function ChangeZip(rng As Range)
With rng.Validation　'入力規則
　　　.Delete
　　　.Add Type:=xlValidateInputOnly
　　　.IMEMode = xlIMEModeHiragana　'IME立ち上げ
End With
　　　　rng.Select
　　　　SendKeys rng.Value '番号を入れる
　　　　SendKeys "{ }" '変換
　　　　SendKeys "{ENTER}"
　　　　SendKeys "{LEFT}"
　　　　SendKeys "{DOWN}"
End Function

お礼

わざわざありがとうございます！！

なんか…すごい・・・
ここまでの次元では考えてなかったので…脱帽です。
こんなこともできるのですね…

ここに掛かれていることを勉強するだけでもすごくためになりました!!
ありがとうございました！

回答No.1

j38

textbox=...の前の行に
msgbox (cell(1,2).value)　とやると
何が表示されます?

お礼

いろいろ他の項目を見て解決いたしました。
ありがとうございます。