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

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

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



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



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

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

サンプルコード

コードの貼り付け場所

'+++ 郵便番号から住所を取得するマクロ +++ 更新:2022/9/1 坂江保 +++
' ・ネットに繋がっていないと使用不可
' ・郵便番号のセル範囲を選択してマクロを実行
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Sub Zipcode_to_address()
    Dim i As Long

    '--- マクロ実行可否判定 ---
    If TypeName(Selection) <> "Range" Then Exit Sub      'セルを選択していなければ終了
    If 1 < Selection.Columns.Count Then Exit Sub         '選択範囲が2列以上なら終了

    '--- 変数 ---
    Dim rngZip As Range
    Set rngZip = Selection                               '対象セル範囲をセット
    ReDim strID(1 To rngZip.Rows.Count) As String        'セルの個数分のString型配列準備
    
    '--- 郵便番号データ整形 ---
    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

    '--- HTMLドキュメント取得 ---
    Dim htmlDoc  As Object
    Set htmlDoc = CreateObject("htmlfile")               'インスタンス生成
    Dim strURL   As String
    Dim strRText As String
    strURL = "https://excel.syogyoumujou.com/vba/dl_file/zipcode.html"
    strRText = Get_HTMLText(strURL)                       'HTMLテキストを取得
    If strRText = "" Then
        MsgBox "ネット上のデータを取得できません", vbExclamation, "中止します"
        GoTo FIN
    End If
    Call htmlDoc.Write(strRText)                         '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

FIN:
    Set htmlDoc = Nothing
    Set rngZip = Nothing
End Sub

'+++ HTMLテキスト取得関数 +++ '【引数】 ' URL :対象ページURL '【戻り値】 ' 文字列  :成功 '  空の文字列:失敗 '++++++++++++++++++++++++++++ Private Function Get_HTMLText(ByVal URL As String) As String Dim datWait As Date datWait = Now() + TimeValue("00:00:20") '現時刻から20秒先の時間を格納 Dim objXMLHTTP As Object Set objXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP") 'インスタンス生成 With objXMLHTTP .Open "GET", URL .Send 'リクエスト送信 Do If datWait < Now() Then Exit Function '20秒以上かかったらエラー終了 Loop Until .readyState = 4 And .Status = 200 'コンテンツ全体を受信できたら抜ける Get_HTMLText = .responseText 'サーバーからの文字列取得 End With Set objXMLHTTP = Nothing End Function

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

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


ページトップへ戻る

Excel 汎用コード



Word 汎用コード

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