Excelで郵便番号から住所変換(WEBSERVICE,Addin,WEBAPI)：還暦後の手習い：SSブログ

	ブログをはじめるログイン

ExcelのリストでOutlookから一..｜Web上でExcel風フィルターの作成ブログトップ

Excelで郵便番号から住所変換(WEBSERVICE,Addin,WEBAPI)　[VBA/VBS] [編集]

　Excel表で郵便番号を入力すると自走で住所が入ると便利なことがある。そこでExcel 2013で追加された「WEBSERVICE」関数、zipcode7.xlaアドイン、普通にWebAPIでXMLデータを取得する方法の３種類作成してみた。

「WEBSERVICE」関数を使用する方法
　こちらの「郵便番号検索API」サービスを使用させてもらい、住所のセルに=FILTERXML(WEBSERVICE("http://zip.cgis.biz/xml/zip.php?zn=" & 郵便番号cell),"/ZIP_result/ADDRESS_value/value[@address]/@address")とすれば簡単に実現できる。
　しかし複数行に渡って入力するには上記の式をコピーになければいけなくスマートではないのでVBAで制御することにした。
サンプル
実際のサンプルはここ
コード

'-------------------------------------------------------------------------------------------
'    Sheet1 マクロ
'　セルの値が変化したときA列の郵便番号をB列の住所に変換
'------------------------------------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim i As Integer
  Dim zipcode, cellad As String
  
  For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
    If Target.Address() = "$A$" + CStr(i) Then
      cellad = "$A$" + CStr(i)
      Cells(i, 2) = zip2address(Range(cellad))
    End If
  Next
End Sub
’------------------------------------------------------------------------------------------------
'   Module1 マクロ
'     FilterXML, WebServiceをWorksheetFunctionを使いvbaで使用
’------------------------------------------------------------------------------------------------
Function zip2address(ByVal 郵便番号 As String)
  Dim httpAdd, State, city, Address As String
  
  郵便番号 = Replace(郵便番号, "-", "")
  httpAdd = "http://zip.cgis.biz/xml/zip.php?zn="
  If 郵便番号 <> "" Then
    State = WorksheetFunction.FilterXML(WorksheetFunction.WebService(httpAdd + 郵便番号), "/ZIP_result/ADDRESS_value/value[@state]/@state")
    city = WorksheetFunction.FilterXML(WorksheetFunction.WebService(httpAdd + 郵便番号), "/ZIP_result/ADDRESS_value/value[@city]/@city")
    Address = WorksheetFunction.FilterXML(WorksheetFunction.WebService(httpAdd + 郵便番号), "/ZIP_result/ADDRESS_value/value[@address]/@address")
  
    zip2address = State + city + Address
 Else
    zip2address = ""
 End If
End Function

Microsoftのzipcode7.xlaアドイン
　インターネットに接続しなくても使えるように、こちらの郵便番号変換アドイン"zipcode7.xla"を使用してみた。本アドインを組み込んで使用する方法は組み込むにも手間がかかること、３ステップもの[郵便番号変換ウィザードステップ］に入力が必要なのでVBAでzipcode7.xlaのコアな機能のみを使ってみることにした。
　しかしaddin側のfunctionを使用するには、Excelの[セキュリィセンター]-[マクロの設定]-[開発者向けのマクロ設定]-[ＶＢＡプロジェクトとオウジェクトモデルへのアクセスを信頼する(Y)]をチェックする必要があることが分かり、この方法も諦め。zipcode7.xlaのコアな機能のみを切り出し、今回作成するExcelのModuleに取り込む方法で実現した。
　取込んだModule(zipcode7.xlaからインポート): Addin_Common, YUBIN7_Core

サンプル
実際のサンプルはここ
コード

'-------------------------------------------------------------------------------------------
'    Sheet1 マクロ
'-------------------------------------------------------------------------------------------
' WEBSERVICEと同じ

’------------------------------------------------------------------------------------------------
'   Module1 マクロ
’------------------------------------------------------------------------------------------------
Public Function zip2address(郵便番号 As String)
    Dim 県 As String * 255, 都市 As String * 255, 都市2 As String * 255
    Dim 町名 As String * 255, 町名2 As String * 255
    Dim Ret As String
    
  If 郵便番号 <> "" Then
    Call YUBIN7_Core.fnStartYubin7
    Call GetZipDecision(郵便番号, 県, 都市, 都市2, 町名, 町名2)
    
    Ret = Replace(県 & 都市 & 都市2 & 町名 & 町名2, Chr(0), vbNullString)
    Ret = Replace(Ret, Chr(32), vbNullString)
    zip2address = Ret
  Else
    zip2address = ""
  End If
End Function

普通にWebAPIでXMLデータを取得する方法
「WEBSERVICE」関数を使用する方法と同じAPIを使用させてもらい、普通にVBAでHTTPリクエストを投げレスポンスを受け取る方法で住所を取得している。
サンプル
実際のサンプルはここ
コード

'-------------------------------------------------------------------------------------------
'    Sheet1 マクロ
'-------------------------------------------------------------------------------------------
' WEBSERVICEと同じ

’------------------------------------------------------------------------------------------------
'   Module1 マクロ
’------------------------------------------------------------------------------------------------
Function zip2address(ByVal 郵便番号 As String)
  Dim objXMLHttp As Object, zipArr, xmldata
  Dim state As String, city As String, address As String

  郵便番号 = Replace(郵便番号, "-", "")
  If 郵便番号 <> "" Then
    Set objXMLHttp = CreateObject("MSXML2.XMLHTTP")
    objXMLHttp.Open "GET", "http://zip.cgis.biz/xml/zip.php?zn=" & 郵便番号, False
    objXMLHttp.Send
    Set xmldata = objXMLHttp.responseXML

    state = xmldata.ChildNodes(1).ChildNodes(9).ChildNodes(4).Attributes.Item(0).Text
    city = xmldata.ChildNodes(1).ChildNodes(9).ChildNodes(5).Attributes.Item(0).Text
    address = xmldata.ChildNodes(1).ChildNodes(9).ChildNodes(6).Attributes.Item(0).Text
    zip2address = state + city + address
  Else
    zip2address = ""
  End If
End Function

2017-02-07 13:08 nice!(0) コメント(2) トラックバック(0)