VBAの行への繰り返し方法について教えてくださいm(__)m

Question

VBAの勉強を始めたばかりの初心者です。

マクロを用いて、WebAPIに接続して郵便番号検索を行うプログラムを実装しました。
セルのD2に郵便番号を記述して、真横のE2に結果が表示されるというものです。

それをD3,D4,D5…と下のセルも同じようにコピーをしたいのですが、プログラムの記述方法が分かりません。

【調べたこと】
まず、セルの行番号の取得関数を調べて実装してみましたが、行番号の取得は出来ましたが、うまく動作しませんでした。
あとは、マクロを行全体にかける方法など思いつく検索キーワードで検索しましたが、実現できませんでした。

お詳しい方いらっしゃいましたら、検索キーワードやヒントをいただけましたら幸いです。

【実現したいことイメージ】
D2 　　　　　 E2
105-0000　　東京都港区
120-0000 東京都足立区
…続く

Private Sub Worksheet_Change(ByVal Target As Range)
'D2のセル値が変更されたときに処理を実行

    If Target.Address = "$D$2" Then
        MsgBox "住所を取得します。"
        Call 郵便番号を取得
    End If

End Sub

Option Explicit


' HTTPにGETメソッドを送信して結果を得る
Function GetHttp(url) As String
    Dim httpObj As Object, s As String
    ' URLのページを開く
    Set httpObj = CreateObject("MSXML2.XMLHTTP")
    httpObj.Open "GET", url
    httpObj.setRequestHeader "Content-Type", "text/plain"
    httpObj.send
    ' 終了まで待機
    Do While httpObj.readyState <> 4
        DoEvents
    Loop
    ' HTTPのステータスコードが200ならば成功
    If (httpObj.Status = 200) Then
        s = httpObj.responseText
        GetHttp = "" & s
    Else
        GetHttp = ""
        Debug.Print "エラー:" & httpObj.statusCode
    End If
End Function


Sub 郵便番号を取得()
    Dim api As String, zip As String
    Dim json As String, result As String
    
    ' APIのURL --- (*1)
    api = "https://api～"
    ' シートから郵便番号の値を取得 --- (*2)
    zip = Sheet1.Range("D2").Value
    ' URLにアクセス --- (*3)
    json = GetHttp(api & zip)
    ' JSONから"result"のキーを抽出 --- (*4)
    result = GetJsonKey(json, "result", False)
    ' シートに設定 --- (*5)
    Sheet1.Range("E2").Value = result
End Sub

' JSON文字列からキーkeyを取り出す --- (*6)
Function GetJsonKey(JsonStr, key, enc) As String
    Dim d As Object
    If JsonStr = "" Then
        GetJsonKey = ""
        Exit Function
    End If
    Set d = CreateObject("htmlfile")
    d.Write "<meta http-equiv='X-UA-Compatible' content='IE=8' />"
    ' JavaScriptの関数を定義 --- (*7)
    d.Write "<script>" & _
            "document.getjson = function(s, key, enc){" & _
            "var vals = eval('('+s+')');" & _
            "if (enc) { return JSON.stringify(vals[key]);}" & _
            "else { return vals[key] }}" & _
            "</script>"
    ' JavaScriptの関数を呼び出す --- (*8)
    GetJsonKey = d.getjson(JsonStr, key, enc)
End Function

何卒よろしくお願いいたします。

Comments

[meg_]

> セルのD2に郵便番号を記述して、真横のE2に結果が表示されるというものです。
質問のコードがそのコードですか？

> うまく動作しませんでした。
どんなコードを書いてどうなったのでしょうか？ エラーが発生したならその内容を追記しましょう。

[ekitabi]

書籍独自のapiを参照しており、apiURLの掲載を控えておりました。
情報不足で大変申し訳ございませんでした。

Answer 1

Private Sub Worksheet_Change(ByVal Target As Range)
'D2のセル値が変更されたときに処理を実行

    Dim c As Range
    For Each c In Target
        If c.Row > 1 And c.Column = 4 Then
            MsgBox "住所を取得します。"
            Call 郵便番号を取得(c)
        End If
    Next
End Sub

Sub 郵便番号を取得(rng As Range)
    Dim api As String, zip As String
    Dim json As String, result As String
    
    ' APIのURL --- (*1)
    api = "https://api～"
    ' シートから郵便番号の値を取得 --- (*2)
    zip = rng.Value
    ' URLにアクセス --- (*3)
    json = GetHttp(api & zip)
    ' JSONから"result"のキーを抽出 --- (*4)
    result = GetJsonKey(json, "result", False)
    ' シートに設定 --- (*5)
    rng.Offset(, 1).Value = result
End Sub

Comments

[ekitabi]

ありがとうございます！！
For　Each文とIF文で実現できること、知りませんでした。
まだまだ初心者なので、これから勉強していきます！
本当にありがとうございました。

Answer 2

現状の 郵便番号を取得 関数は郵便番号セルが固定ですので、郵便番号セルを引数で渡すようにします。
住所セルは郵便番号セルの右隣ですので、Offsetで指定します。

Sub 郵便番号を取得(zipCell As Range)
    Dim api As String, zip As String
    Dim json As String, result As String
    
    ' APIのURL --- (*1)
    api = "https://api～"
    ' シートから郵便番号の値を取得 --- (*2)
    zip = zipCell.Value
    ' URLにアクセス --- (*3)
    json = GetHttp(api & zip)
    ' JSONから"result"のキーを抽出 --- (*4)
    result = GetJsonKey(json, "result", False)
    ' シートに設定 --- (*5)
    zipCell.Offset(, 1).Value = result
End Sub

ワークシートのChangeいベントは下記のように記述します。

Private Sub Worksheet_Change(ByVal Target As Range)
'D列の2行目以下のセルが変更されたとき処理を実行

    Dim zipRng As Range, zipCell As Range
    Set zipRng = Intersect(Target, Range("D2:D" & Rows.Count)) 'D列で変更されたCellを取得(複数変更の場合も考慮)
    If zipRng Is Nothing Then Exit Sub '変更されたセルがなければ処理終了
    
    Application.EnableEvents = False '処理中にセルを変更するのでChangeイベントの連鎖を抑止
    
    MsgBox "住所を取得します。"
    For Each zipCell In zipRng
        Call 郵便番号を取得(zipCell)
    Next
    
    Application.EnableEvents = True
End Sub

Comments

[ekitabi]

ご丁寧にありがとうございます！
実現することが出来ました！

offsetで行や列の移動が出来ること、 Intersect文、イベント連鎖の抑制（自分で調べていた時に、無限ループにはまっていましたので、大変勉強になりました）など、まだまだ知らないことばかりでした。
勉強していきます！
ありがとうございました！