Excel×ラッコキーワードAPIでメディア運営を効率化しよう！【初心者向け】

Option Explicit

'==========================================
' ラッコキーワードAPI 設定
'==========================================
' 発行したAPIキーを、以下の「YOUR_API_KEY_HERE」に置き換えてください。
Private Const API_KEY As String = "YOUR_API_KEY_HERE"

' エンドポイント：関連キーワード取得
Private Const API_URL As String = "https://api.rakkokeyword.com/v1/related-keywords"

'------------------------------------------
' メイン処理（このマクロを実行します）
'------------------------------------------
Public Sub GetRelatedKeywords()

    Dim keyword As String
    keyword = Trim$(InputBox("取得したい関連キーワードを入力してください:", "ラッコキーワードAPI"))
    If keyword = "" Then Exit Sub

    If API_KEY = "YOUR_API_KEY_HERE" Then
        MsgBox "コード先頭の API_KEY を、発行したAPIキーに置き換えてください。", vbExclamation
        Exit Sub
    End If

    ' 検索条件の指定（並び順：月間検索数の多い順／取得件数：100件）
    Dim payload As String
    payload = "{""keyword"":""" & JsonEscape(keyword) & """," & _
              """sortBy"":""searchVolume""," & _
              """orderBy"":""desc""," & _
              """limit"":100}"

    On Error GoTo ErrHandler

    ' API通信の実行
    Dim http As Object
    Set http = CreateObject("MSXML2.XMLHTTP")
    http.Open "POST", API_URL, False
    http.setRequestHeader "Content-Type", "application/json;charset=UTF-8"
    http.setRequestHeader "Accept", "application/json"
    http.setRequestHeader "X-API-Key", API_KEY
    http.send payload

    Dim body As String
    body = Utf8Text(http.responseBody)

    ' エラーハンドリング
    If http.Status <> 200 Then
        MsgBox "通信に失敗しました。" & vbCrLf & _
               "ステータスコード: " & http.Status & vbCrLf & _
               "エラー詳細: " & Left$(body, 500), vbExclamation, "APIエラー"
        Exit Sub
    End If

    ' JSONを「キーワード＋月間検索数」の行データに変換
    Dim tsv As String
    tsv = ItemsToTsv(body)
    If Len(tsv) = 0 Then
        MsgBox "関連キーワードが見つかりませんでした。", vbInformation
        Exit Sub
    End If

    ' シートへの書き込み準備（1行目はヘッダー）
    Dim lines() As String, cols() As String, i As Long
    lines = Split(tsv, vbLf)

    Dim out() As Variant
    ReDim out(1 To UBound(lines) + 2, 1 To 2)
    out(1, 1) = "キーワード"
    out(1, 2) = "月間検索数"

    For i = 0 To UBound(lines)
        cols = Split(lines(i), vbTab)
        out(i + 2, 1) = cols(0)
        If cols(1) = "" Then
            out(i + 2, 2) = "データなし"
        Else
            out(i + 2, 2) = CDbl(cols(1))
        End If
    Next i

    ' シートへの書き込み実行（現在のシートを上書き）
    With ActiveSheet
        .Cells.ClearContents
        .Range("A1").Resize(UBound(out, 1), 2).Value = out
        .Rows(1).Font.Bold = True
        .Columns("A:B").AutoFit
    End With

    MsgBox "データの取得と書き込みが完了しました！（" & (UBound(lines) + 1) & "件）", vbInformation
    Exit Sub

ErrHandler:
    MsgBox "処理中にエラーが発生しました:" & vbCrLf & Err.Description, vbCritical
End Sub

'------------------------------------------
' 補助関数
'------------------------------------------
' 入力文字列をJSONの値として安全な形に変換する
Private Function JsonEscape(ByVal s As String) As String
    s = Replace(s, "\", "\\")
    s = Replace(s, """", "\""")
    JsonEscape = s
End Function

' レスポンス（バイト列）をUTF-8の文字列に変換する（日本語の文字化け対策）
Private Function Utf8Text(ByVal bin As Variant) As String
    Dim st As Object
    Set st = CreateObject("ADODB.Stream")
    st.Type = 1
    st.Open
    st.Write bin
    st.Position = 0
    st.Type = 2
    st.Charset = "utf-8"
    Utf8Text = st.ReadText
    st.Close
End Function

' JSONを解析し「キーワード[TAB]月間検索数」を1行ずつ並べた文字列を返す
Private Function ItemsToTsv(ByVal jsonText As String) As String
    Dim ht As Object, js As String
    Set ht = CreateObject("htmlfile")
    ht.Write "<meta http-equiv=""x-ua-compatible"" content=""IE=9"">"
    js = "function toTsv(s){" & _
         "var o = JSON.parse(s);" & _
         "var a = (o.data && o.data.items) ? o.data.items : [];" & _
         "var r = [];" & _
         "for (var i = 0; i < a.length; i++) {" & _
         "var m = a[i].metrics || {};" & _
         "var v = (m.searchVolume === null || m.searchVolume === undefined) ? '' : m.searchVolume;" & _
         "r.push(a[i].keyword + '\t' + v); }" & _
         "return r.join('\n'); }"
    ht.parentWindow.execScript js, "JScript"
    ItemsToTsv = ht.parentWindow.toTsv(jsonText)
End Function

ラッコキーワードAPIの仕様に基づき、Excel VBAのコードを作成してください。

【やりたいこと】
※この欄だけを、自分が実現したいことに書き換えてください。
　AI向け：空欄の場合、読者に何がやりたいのかをヒアリングしてください。

【あなたに判断してほしいこと】
・添付したAPIドキュメントの中から、【やりたいこと】を実現するのに最も適した機能を選んでください
・取得条件（取得件数・並び順・絞り込みなど）と、シートに出力する項目も、【やりたいこと】に合うものを提案してください
・1つの機能では足りない場合は、複数の機能を組み合わせた構成を提案してください
・どの機能をなぜ選んだのか、取得したデータをどう見ればよいのかを、コードの前に簡潔に説明してください

【判断に迷う場合】
・【やりたいこと】だけでは決められない点（調べたいキーワード、取得件数、出力したい項目、対象の検索エンジンなど）があれば、コードを書く前にまとめて質問してください
・こちらはプログラミングの知識がないため、専門用語を使わずに質問してください

【動作環境】
・Windows版のデスクトップExcel
・参照設定（外部ライブラリの追加）は使わず、CreateObjectだけで動くコードにしてください

【期待する動作】
・マクロを実行すると、必要な入力（キーワードなど）を求めるダイアログが表示される
・入力するとデータを取得し、結果をシートに書き出す
・1行目の見出し（ヘッダー）はコードで自動的に作ってほしい

【その他のお願い】
・APIキーを入れる場所は、コードの一番上に「YOUR_API_KEY_HERE」のように分かりやすく定義し、後ほど手動で書き換えやすいようにすること
・日本語が文字化けしないよう、レスポンスはUTF-8として読み取ること
・VBAには標準のJSON解析機能がないため、JSONを解析する処理もコード内に含めること
・エラーが起きたときは、原因が分かるメッセージを表示すること
・関数名や変数名などは、AI側で分かりやすいものにしてください