以下は、KEN_ALLベースのローカルDB検索を優先し、未ヒット時にAPI検索＋キャッシュ追記、さらにAPI失敗時のリトライ・ログ出力まで含めた「実務向けの完全版VBA」です。A列に郵便番号、B～D列に住所（都道府県・市区町村・町域）を出力する想定です。
構成概要
- Local DB（ZipDBシート）検索：高速・大量処理向け
- API検索（zipcloud）：未ヒットや最新性補完用
- キャッシュ追記：API取得結果をZipDBに追加して次回以降はDB参照
- エラーハンドリング：APIのリトライ（最大3回）、ログ出力
前提
- ブック内にシート「ZipDB」を用意（列A: 郵便番号、B: 都道府県、C: 市区町村、D: 町域）
- 住所出力先は「アクティブシート」のB～D列
- JSON解析に VBA-JSON（JsonConverter.bas）を導入済み
- 参照設定不要版（CreateObject利用）
コード
Option Explicit
' ========= エントリーポイント =========
Sub ProcessZipHybrid()
Dim lastRow As Long, i As Long
Dim zip As String, addrPref As String, addrCity As String, addrTown As String
Dim found As Boolean
' データ行（A列）を自動検出
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
If lastRow < 2 Then
MsgBox "処理対象の郵便番号がありません。", vbInformation
Exit Sub
End If
' 画面更新停止（高速化）
Application.ScreenUpdating = False
For i = 2 To lastRow
zip = NormalizeZip(Cells(i, 1).Value)
If zip = "" Then
' 空行スキップ
GoTo CONTINUE_NEXT
End If
' 1) ローカルDB検索
found = SearchLocalDB(zip, addrPref, addrCity, addrTown)
If Not found Then
' 2) API検索（リトライ＆ログ付き）
found = SearchAPIWithRetry(zip, addrPref, addrCity, addrTown)
' 3) API成功ならキャッシュ追記
If found Then
AppendToLocalDB zip, addrPref, addrCity, addrTown
End If
End If
' 4) 出力
If found Then
Cells(i, 2).Value = addrPref
Cells(i, 3).Value = addrCity
Cells(i, 4).Value = addrTown
Else
Cells(i, 2).Value = "取得失敗"
Cells(i, 3).Value = ""
Cells(i, 4).Value = ""
End If
CONTINUE_NEXT:
Next i
Application.ScreenUpdating = True
MsgBox "処理が完了しました。", vbInformation
End Sub
' ========= 郵便番号整形 =========
Function NormalizeZip(ByVal raw As String) As String
Dim z As String
z = Trim(CStr(raw))
If z = "" Then
NormalizeZip = ""
Exit Function
End If
z = Replace(z, "-", "")
z = Replace(z, "ー", "") ' 長音の誤入力対策例
' 7桁のみ許容（先頭ゼロも保持）
If Len(z) = 7 And IsNumeric(z) Then
NormalizeZip = z
Else
NormalizeZip = ""
End If
End Function
' ========= ローカルDB検索（ZipDBシート） =========
Function SearchLocalDB(zip As String, _
ByRef pref As String, _
ByRef city As String, _
ByRef town As String) As Boolean
Dim ws As Worksheet
Dim rng As Range, foundCell As Range
On Error GoTo ERR_HANDLER
Set ws = ThisWorkbook.Worksheets("ZipDB")
' 郵便番号は列Aで検索
Set rng = ws.Range("A:A")
Set foundCell = rng.Find(What:=zip, LookIn:=xlValues, LookAt:=xlWhole)
If Not foundCell Is Nothing Then
pref = ws.Cells(foundCell.Row, 2).Value
city = ws.Cells(foundCell.Row, 3).Value
town = ws.Cells(foundCell.Row, 4).Value
SearchLocalDB = True
Else
SearchLocalDB = False
End If
Exit Function
ERR_HANDLER:
WriteLog "ローカルDB検索エラー: zip=" & zip & " desc=" & Err.Description
SearchLocalDB = False
End Function
' ========= API検索（zipcloud）＋リトライ＆ログ =========
Function SearchAPIWithRetry(zip As String, _
ByRef pref As String, _
ByRef city As String, _
ByRef town As String) As Boolean
Dim url As String, i As Integer
Dim http As Object
Dim responseText As String
Dim JSON As Object, result As Object
On Error GoTo ERR_HANDLER
url = "https://zipcloud.ibsnet.co.jp/api/search?zipcode=" & zip
For i = 1 To 3
Set http = CreateObject("MSXML2.XMLHTTP")
http.Open "GET", url, False
http.Send
If http.Status = 200 Then
responseText = http.responseText
Set JSON = JsonConverter.ParseJson(responseText)
If JSON("status") = 200 Then
' resultsは配列（0ベースだがVBA-JSONは1ベースのCollection）
If JSON("results").Count >= 1 Then
Set result = JSON("results")(1)
pref = NzString(result("address1"))
city = NzString(result("address2"))
town = NzString(result("address3"))
SearchAPIWithRetry = (pref <> "" And city <> "")
Exit Function
End If
Else
' API側の業務エラー（例：不正郵便番号）
WriteLog "API業務エラー: zip=" & zip & " code=" & JSON("status") & " msg=" & NzString(JSON("message"))
End If
Else
' 通信失敗（HTTPステータス控え）
WriteLog "API通信失敗: zip=" & zip & " http=" & http.Status
End If
' ウェイト（2秒）
Application.Wait (Now + TimeValue("0:00:02"))
Next i
SearchAPIWithRetry = False
Exit Function
ERR_HANDLER:
WriteLog "API例外: zip=" & zip & " desc=" & Err.Description
SearchAPIWithRetry = False
End Function
' ========= ローカルDBへキャッシュ追記 =========
Sub AppendToLocalDB(zip As String, pref As String, city As String, town As String)
Dim ws As Worksheet
Dim nextRow As Long
On Error GoTo ERR_HANDLER
Set ws = ThisWorkbook.Worksheets("ZipDB")
nextRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1
ws.Cells(nextRow, 1).Value = zip
ws.Cells(nextRow, 2).Value = pref
ws.Cells(nextRow, 3).Value = city
ws.Cells(nextRow, 4).Value = town
Exit Sub
ERR_HANDLER:
WriteLog "キャッシュ追記エラー: zip=" & zip & " desc=" & Err.Description
End Sub
' ========= 文字列Null対策（Nothing/Null→空文字） =========
Function NzString(v) As String
On Error Resume Next
If IsNull(v) Then
NzString = ""
Else
NzString = CStr(v)
End If
End Function
' ========= ログ出力（テキスト追記） =========
Sub WriteLog(msg As String)
Dim fso As Object, ts As Object
Dim logPath As String
logPath = ThisWorkbook.Path & "\ZipHybridLog.txt"
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.OpenTextFile(logPath, 8, True) ' 8=Append
ts.WriteLine Format(Now, "yyyy/mm/dd hh:nn:ss") & " " & msg
ts.Close
End Sub
運用のコツ
- ZipDBはKENA LL.CSVを定期更新しておくとAPIヒット率が下がり、全体の速度が上がります。
- API結果はキャッシュされるため、同じ郵便番号を再処理すると通信せずにDBから即返却されます。
- ログファイル（ZipHybridLog.txt）で失敗要因を追跡し、ネットワークやAPI制限の確認に役立ててください。
