郵便番号一覧から住所を求めていくREST APIを使ったVBAのサンプルコード(zipcloud版)

VBA
記事内に広告が含まれています。

郵便番号一覧から住所を求めていく、REST APIを使ったVBAのサンプルコードを公開してみます。

使用するWebAPI

Excel単体で住所情報検索はできないので、下記「郵便番号検索API」の力を借ります。

サービス名郵便番号検索API
運営株式会社アイビス
URLhttps://zipcloud.ibsnet.co.jp/doc/api
概要郵便番号検索APIは、日本郵便が公開している郵便番号データを検索する機能をRESTで提供しています。

仕様

画面仕様

  • 表のA列に住所を求めたい「郵便番号」の一覧を入力しています。
  • 表の右に住所出力の実行ボタンが配置されています。
  • 実行ボタンを押下すると、B列とC列に「住所」と「住所(カナ)」が出力されます。

ソースコード

01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
Sub ボタン1_Click()
    Dim objXMLHttp As Object, zipArr
    Dim yubinNo As String
    Dim splitLine() As String
    
    Dim i As Long
    i = 2 '行番号
     
    Do While Cells(i, 1).value <> ""
        '入力値からハイフンの削除
        yubinNo = Replace(Worksheets("Sheet1").Cells(i, 1).value, "-", "")
     
        Set objXMLHttp = CreateObject("MSXML2.XMLHTTP")
        objXMLHttp.Open "GET", "https://zipcloud.ibsnet.co.jp/api/search?zipcode=" & yubinNo, False
        objXMLHttp.Send
         
        Dim address As String
        Dim kana As String
        address = ""
        kana = ""
         
        'JSON-Paserなしを前提としたコード
        Dim text As Variant
        text = Split(objXMLHttp.responseText, vbLf)
        For j = 0 To UBound(text)
            Dim line As String
            line = text(j)
            '住所
            If InStr(line, "address") Then
                address = address + getFormattedValue(line)
                 
                '改行
                If InStr(line, "address3") Then
                    address = address + vbLf
                End If
                 
            End If
             
            'カナ
            If InStr(line, "kana") Then
                kana = kana + getFormattedValue(line)
                 
                '改行
                If InStr(line, "kana3") Then
                    kana = kana + vbLf
                End If
                 
            End If
             
        Next j
         
        '余計な改行を除去
        If Right(address, 1) = vbLf Then
            address = Left(address, Len(address) - 1)
        End If
        If Right(kana, 1) = vbLf Then
            kana = Left(kana, Len(kana) - 1)
        End If
         
        'セル格納
        Worksheets("Sheet1").Cells(i, 2).value = address
        Worksheets("Sheet1").Cells(i, 3).value = kana
      
        i = i + 1
    Loop
     
End Sub
Function getFormattedValue(value As String)
    Dim reg As Object
    Set reg = CreateObject("VBScript.RegExp")
 
    With reg
        .Pattern = "^.+:\s""|"",$"     ' "^.+:\s"|",$"     行が「"address1": "高知県",」ならば、高知県の前の~": "と後の",を削除
        .IgnoreCase = False            ' 大文字小文字区別
        .Global = True                 ' 文字列全体対象
    End With
     
    getFormattedValue = reg.Replace(value, "") ' 空文字に置換
     
End Function

ソースコードの補足

郵便番号の数だけ、下記の処理を繰り返します。

  1. A列にある郵便番号の値を1つ取得します。
  2. 郵便番号をもとに「郵便番号検索API」から、郵便番号に対応した住所を取得します。
  3. APIから取得した住所をExcelシートのB列、C列に出力します。
    • 住所情報が分割されているので結合します
    • もし複数件の住所がある場合は、改行して出力します


APIから返ってくる値はJSON形式です。
VBAでJSONを使用する場合、JSON Parserを使用するときれいに扱えるのですが、別途モジュールのインポートが必要です。
私のPCをクリーンにするため、正規表現を使って加工していますが、どちらでもよいかとおもいます。
※別サイトではJSON Parserの例が紹介されています。

実行結果

ボタンを押下した結果、住所欄と住所(カナ)欄に住所が出力されました。

参考情報

環境

下記の環境で作成・実行しております。

No.環境バージョン
1OSWindows11
2ExcelExcel2016
環境一覧

以上です。