郵便番号を入れると住所が出るマクロを組みたい

質問

A列に郵便番号を入れると、（例：123-4567）B列に住所が出るマクロを組みたいのですが
なかなかできません。例えばA１セルに入力するとB１セルに。A4セルに入力するとB４セルに
出るといった感じです。インターネットで調べながら、

Option Explicit

' ワークシートのChangeイベント記述
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xlAPP As Application

' 郵便番号セル以外では動作させない
If Target.Address <> "$A$1" Then Exit Sub ' (1)

' 3桁以上の郵便番号があり、住所がブランクの場合のみ住所を変換させる
If ((Len(Cells(1, 1).Value) >= 3) And (Cells(1, 2).Value = "")) Then ' (2)
Set xlAPP = Application
xlAPP.EnableEvents = False ' (3)
' 郵便番号を全角変換し住所に転記
Cells(1, 2).Value = StrConv(Target.Value, vbWide) ' (4)
' 住所のセルを選択
Cells(1, 2).Select ' (5)
' F2 → Shift+Home → F13 を擬装入力する
SendKeys "{F2}", True ' 編集モード ' (6)
SendKeys "+{HOME}", True ' 文字列全体を選択 ' (7)
SendKeys "{F13}", True ' 再変換(MS-IME) ' (8)
xlAPP.EnableEvents = True
End If
End Sub

というコードを作ったのですが、これはA1セルしか対応しておらず、A列全体で対応できません。
何か方法があればご教授いただけたら幸いです。

回答No.1

keithin · ベストアンサー

「Ａ１セル」あるいは「１行目」を指定している箇所を漏れなく修正します。

変更例：今のマクロを全て消して下記に差し替える
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xlAPP As Application

' 郵便番号セル以外では動作させない
If Target.column <> 1 Then Exit Sub ' (1)
if target.count > 1 then exit sub

' 3桁以上の郵便番号があり、住所がブランクの場合のみ住所を変換させる
If ((Len(Cells(target.row, 1).Value) >= 3) And (Cells(target.row, 2).Value = "")) Then ' (2)
Set xlAPP = Application
xlAPP.EnableEvents = False ' (3)
' 郵便番号を全角変換し住所に転記
Cells(target.row, 2).Value = StrConv(Target.Value, vbWide) ' (4)
' 住所のセルを選択
Cells(target.row, 2).Select ' (5)
' F2 → Shift+Home → F13 を擬装入力する
SendKeys "{F2}", True ' 編集モード ' (6)
SendKeys "+{HOME}", True ' 文字列全体を選択 ' (7)
SendKeys "{F13}", True ' 再変換(MS-IME) ' (8)
xlAPP.EnableEvents = True
End If
End Sub

お礼

ご回答ありがとうございます。
無事できることができました。本当に感謝いたします。

回答No.2

nicotinism

横からすみません。
郵便番号ウィザードでは・・・
2007-2010
http://office.microsoft.com/ja-jp/excel-help/HP010077514.aspx

2000-2007
http://www.microsoft.com/downloads/ja-jp/details.aspx?FamilyID=6F6AF8EF-B9DD-4E21-9E63-AF4A0FF4E7CE&displaylang=ja

人は易きに流れ。。。

お礼

ご回答ありがとうございます。郵便番号変換ウィザードでは一気に変換するしか方法がなく、
途中のセルを修正したいときにすぐに確かめることができず使い勝手が悪いため使用していません。