トップ > 汎用コード > 郵便番号から都道府県と市区町村を一括取得・設定

郵便番号から都道府県と市区町村を一括取得・設定住所データ更新:2021/7/9

郵便番号のデータから、都道府県と市区町村のデータを取得し、設定するマクロです。
住所データはネット上から取得しますのでアドイン等は不要です。
郵便番号を選択し、下のサンプルコードを実行すると、
一つ右のセルに都道府県、更にもう一つ右のセルにそれ以後のデータが設定されます。



ネット上からデータを取得する関係上、ネット接続が必須のマクロです。
ネット接続されていない場合は、情報を得られません。



■郵便番号:〒
 ・ハイフン(-)はあってもなくても構いません
 ・全角・半角のどちらにも対応しています
 ・空欄の場合はそのセルの処理を飛ばします
 ・データを取得できない場合はその旨を表示します

※一連のデータは日本郵政株式会社のものを利用させていただいております

コードの貼り付け場所

サンプルコード

'//////郵便番号から住所を取得するマクロ////// 2021/7/9 坂江保

' ・ネットに繋がっていないと使用不可
' ・郵便番号のセル範囲を選択してマクロを実行

Sub Zipcode_to_address()
    If TypeName(Selection) <> "Range" Then Exit Sub         'セルを選択していなければ終了
    If 1 < Selection.Columns.Count Then Exit Sub            '選択範囲が2列以上なら終了

    Dim rngZip As Range, strID() As String, i As Long

    Set rngZip = Selection
    ReDim strID(1 To rngZip.Rows.Count)
    For i = 1 To rngZip.Rows.Count
        strID(i) = StrConv(rngZip.Cells(i, 1), vbNarrow)    '全角の場合は半角に
        strID(i) = Replace$(strID(i), "-", "")              'ハイフンを削除
        strID(i) = Replace$(strID(i), " ", "")              'スペースを削除
        strID(i) = WorksheetFunction.Clean(strID(i))        '改行等削除
    Next

    Dim htmlDoc As Object
    Set htmlDoc = CreateObject("htmlfile")                  'インスタンス生成
    Call Get_HtmlDoc(htmlDoc)                               'HTMLドキュメントを取得

    Application.ScreenUpdating = False
    On Error Resume Next
        For i = LBound(strID) To UBound(strID)
            If 0 < Len(strID(i)) Then
                Dim varSpt As Variant
                varSpt = htmlDoc.getElementById(strID(i)).innerTEXT 'ID(郵便番号)から住所取得
                If ERR.Number = 0 Then
                    varSpt = Split(varSpt, ",")
                    rngZip(i, 1).Offset(, 1).Value = varSpt(0) '都道府県書き出し
                    rngZip(i, 1).Offset(, 2).Value = varSpt(1) '市区町村書き出し
                Else
                    rngZip(i, 1).Offset(, 1).Value = "住所を取得できませんでした"
                    ERR.Clear
                End If
            End If
        Next
    On Error GoTo 0
    Application.ScreenUpdating = True
    Set htmlDoc = Nothing
End Sub

Private Sub Get_HtmlDoc(htmlDoc As Object) 'ネットよりHTMLを取得しドキュメントに書き出し Dim datWait As Date datWait = Now() + TimeValue("00:00:20") '現時刻から20秒先の時間を格納 On Error GoTo ERR Dim objXMLHTTP As Object Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP.6.0") With objXMLHTTP .Open "GET", "https://excel.syogyoumujou.com/vba/dl_file/zipcode.html", False .Send 'リクエスト送信 Do If datWait < Now() Then GoSub ERR '20秒以上かかったらエラー終了 Loop While objXMLHTTP.readyState < 4 If .Status <> 200 Then GoSub ERR 'リクエストが成功しなかったら終了 htmlDoc.write .responseText 'HTMLドキュメントに書き出し End With Set objXMLHTTP = Nothing On Error GoTo 0 Exit Sub ERR: MsgBox "ネット上のデータを取得できません", vbExclamation, "中止します": End End Sub

書籍紹介本を執筆しました

VBA好きに贈る 高速化の教科書
「あなたのマクロが激速化!! Excel VBA 高速化 ~観点と実践~」(Kindle版)
マクロの高速化と一口にいっても、ExcelやVBAの仕様や特性上のもの、システムデザインといった枠組みの考え方、プログラムのテクニックといったパートに大別できます。 それらの視点や考え方といった観点を整理しながら、実践につながるデザイン思考やテクニックに踏み込んでいます。

ページトップへ戻る

Excel 汎用コード

Word 汎用コード

Copyright(C) 2009- 坂江 保 All Rights Reserved.