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

郵便番号から都道府県と市区町村を一括取得・設定2021.07.09   更新:2023.04.11

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



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



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

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


【お薦め】マクロ・プロシージャを管理する無料のツール!
 Excelマクロ管理ツール

サンプルコード2021.07.09 更新:2023.04.11

コードの貼り付け場所

'-----------------------------------------------------
' 郵便番号から住所を取得するマクロ 更新:2023.04.11
'-----------------------------------------------------
' ・ネットに繋がっていないと使用不可
' ・郵便番号のセル範囲を選択してマクロを実行
' https://excel.syogyoumujou.com/vba/zipcode.html
'-----------------------------------------------------
Sub ZipcodeToAddress()
    
    'マクロ実行可否判定
    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型配列準備
    
    '郵便番号データ整形
    Dim i As Long
    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 = GetHtmlText(strURL)                       'HTMLテキストを取得
    If strRText = "" Then
        MsgBox "ネット上のデータを取得できませんでした", vbExclamation, "中止します"
        GoTo Finally
    End If
    
    'HTMLドキュメント書き出し
    htmlDoc.Write strRText
    
    '取得したデータの書き出し
    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

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

'----------------------------------------------------- ' HTMLテキスト取得関数 '----------------------------------------------------- '[引数] ' URL :対象ページURL '[戻り値] ' 成功:HTMLテキスト '  失敗:空の文字列 '----------------------------------------------------- Function GetHtmlText(ByVal URL As String) As String On Error Resume Next Dim objXMLHTTP As Object Set objXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP") 'インスタンス生成 With objXMLHTTP .Open "GET", URL .Send 'リクエスト送信 GetHtmlText = .responseText 'サーバーからの文字列取得 End With Set objXMLHTTP = Nothing On Error GoTo 0 End Function

書籍紹介

知りたいがすぐわかる! やりたいがすぐできる!
「Excel VBA 逆引きで学ぶ ユーザーフォーム&コントロール」(Kindle版)
ユーザーフォームを扱えると、VBAでできることが大きく広がります!
本書では、知りたいこと、やりたいことから、逆引きで学びを深められます。
※ 第1章~5章まで公開しています


ページトップへ戻る

Excel 汎用コード

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