J-QuantsAPI をChatGPTに聞いてExcel VBAで書き直す（続き、銘柄リスト取得その2）

2023年5月2日 15:00

出力部分も聞いてみる

昨日、ChatGPTに質問して、銘柄リストのデータをデバッグウインドウに出力することができました。
これでJ-Quants API のpythonサンプルコードをExcel VBA に書き直すという当初の目的はほぼ達成です。

ここで止めても良いのですが、ついでに出力部分も書いてもらえるか試してみます。
出力はデータの形を見ながら地道に書いていく作業です。
これがAIにお任せ！で出来るなら素晴らしいです。

質問
昨日提案してもらった次のExcelVBAのコード

Sub GetListedInfoRequest()
    Dim HttpReq As Object
    Dim Url As String
    Dim IdToken As String
    Dim Headers As Object
    Dim Response As String
    Dim Json As Object
    Dim key As Variant ' keyを宣言する
    
    Set HttpReq = CreateObject("MSXML2.XMLHTTP")
    
    Url = "https://api.jquants.com/v1/listed/info"
    IdToken = "YOUR idToken"
    
    Set Headers = CreateObject("Scripting.Dictionary")
    Headers("Authorization") = "Bearer " & IdToken
    
    HttpReq.Open "GET", Url, False
    For Each key In Headers
        HttpReq.setRequestHeader key, Headers(key)
    Next
    HttpReq.send
    
    Response = HttpReq.responseText
    Set Json = JsonConverter.ParseJson(Response)
    
    'ここからは、JSONレスポンスから必要な情報を抽出する例です
    Dim Symbol As String
    Dim Name As String
    Dim Price As Double
    
    Symbol = Json("symbol")
    Name = Json("name")
    Price = Json("price")
    
End Sub

のJSONレスポンスから必要な情報を抽出する部分を
Date
Code
CompanyName
CompanyNameEnglish
Sector17Code
Sector17CodeName
Sector33Code
Sector33CodeName
ScaleCategory
MarketCode
MarketCodeName
の項目を出力する様に書き換えてください。
出力先は、ワークシート名"output"で、レコード毎に各項目をcells(1,1)から1セルづつ横に記入し、次のレコードは１行下に記入してください。

返答
以下が、指定された内容に基づいて書き換えたコードになります。必要な情報をJSONレスポンスから抽出し、"output"というワークシートに出力するようになっています。

Sub GetListedInfoRequest()
    Dim HttpReq As Object
    Dim Url As String
    Dim IdToken As String
    Dim Headers As Object
    Dim Response As String
    Dim Json As Object
    Dim key As Variant ' keyを宣言する
    
    Set HttpReq = CreateObject("MSXML2.XMLHTTP")
    
    Url = "https://api.jquants.com/v1/listed/info"
    IdToken = "YOUR idToken"
    
    Set Headers = CreateObject("Scripting.Dictionary")
    Headers("Authorization") = "Bearer " & IdToken
    
    HttpReq.Open "GET", Url, False
    For Each key In Headers
        HttpReq.setRequestHeader key, Headers(key)
    Next
    HttpReq.send
    
    Response = HttpReq.responseText
    Set Json = JsonConverter.ParseJson(Response)
    
    'ここからは、JSONレスポンスから必要な情報を抽出し、ワークシートに出力する例です
    Dim OutputSheet As Worksheet
    Dim RowIndex As Long
    
    Set OutputSheet = ThisWorkbook.Worksheets("output")
    RowIndex = OutputSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1 '最終行を取得して、次の行に出力する
    
    OutputSheet.Cells(RowIndex, 1).Value = Json("date")
    OutputSheet.Cells(RowIndex, 2).Value = Json("code")
    OutputSheet.Cells(RowIndex, 3).Value = Json("companyName")
    OutputSheet.Cells(RowIndex, 4).Value = Json("companyNameEnglish")
    OutputSheet.Cells(RowIndex, 5).Value = Json("sector17Code")
    OutputSheet.Cells(RowIndex, 6).Value = Json("sector17CodeName")
    OutputSheet.Cells(RowIndex, 7).Value = Json("sector33Code")
    OutputSheet.Cells(RowIndex, 8).Value = Json("sector33CodeName")
    OutputSheet.Cells(RowIndex, 9).Value = Json("scaleCategory")
    OutputSheet.Cells(RowIndex, 10).Value = Json("marketCode")
    OutputSheet.Cells(RowIndex, 11).Value = Json("marketCodeName")
    
End Sub

このコードを実行すると、"output"ワークシートにレコードが追加され、指定された項目が1行ずつ記入されます。注意点としては、このコードを実行する前に、`JSONConverter`というライブラリを追加する必要がある点です。また、idTokenの部分は自分のアクセストークンに置き換える必要があります。
--- 以上返答 -------------------

データの形式を指定

以前pythonでβ版のコードを作って銘柄データを取得しました。
その時と何か違うような気がします。

改めて整形前の銘柄データを取得し、viで覗いてみました。

{"info": [{"Date": "2023-02-07", "Code": "13010", "CompanyName": "極洋",

の樣に、{"info":[{"date":"",…},…{…}] の構造になっていました。

これを加味して改めて質問します。

質問
Responseの内容が以下のデータ形式であると分かりました。
{"info": [{"Date": "2023-02-07", "Code": "13010", "CompanyName": "極洋", "CompanyNameEnglish": "KYOKUYO CO.,LTD.", "Sector17Code": "1", "Sector17CodeName": "食>品", "Sector33Code": "0050", "Sector33CodeName": "水産・農林業", "ScaleCategory": "TOPIX Small 2", "MarketCode": "0111", "MarketCodeName": "プライム"}, {"Date": "2023-02-07", "Code": "13050", "CompanyName": "大和アセットマネジメント株式会社
　ダイワ上場投信−トピックス", "CompanyNameEnglish": "Daiwa ETF-TOPIX", "Sector17Code": "99", "Sector17CodeName": "その他", "Sector33Code": "9999", "Sector33CodeName": "その他", "ScaleCategory": "-", "MarketCode": "0109", "MarketCodeName": "その他"}, ... ,{...}]}
出力先は、ワークシート名"output"で、jsonkey"info"で取り出される最初のレコードの各項目をcells(1,1)から1セルづつ横に記入し、次のレコードは１行下に同じ様に記入してください。'JSONConverter'は組込済みなため説明不要です。
-- 以上質問 -------------------

返答
以下がコード例になります。

Sub GetListedInfoRequest()
Dim HttpReq As Object
Dim Url As String
Dim IdToken As String
Dim Headers As Object
Dim Response As String
Dim Json As Object
Dim InfoArray As Variant
Dim Info As Object
Dim i As Long

Set HttpReq = CreateObject("MSXML2.XMLHTTP")

Url = "https://api.jquants.com/v1/listed/info"
IdToken = "YOUR idToken"

Set Headers = CreateObject("Scripting.Dictionary")
Headers("Authorization") = "Bearer " & IdToken

HttpReq.Open "GET", Url, False
For Each key In Headers
    HttpReq.setRequestHeader key, Headers(key)
Next
HttpReq.send

Response = HttpReq.responseText
Set Json = JsonConverter.ParseJson(Response)
InfoArray = Json("info")

Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("output")
Dim row As Long
row = 1

' ヘッダー行を書き込む
ws.Cells(row, 1).Value = "Date"
ws.Cells(row, 2).Value = "Code"
ws.Cells(row, 3).Value = "CompanyName"
ws.Cells(row, 4).Value = "CompanyNameEnglish"
ws.Cells(row, 5).Value = "Sector17Code"
ws.Cells(row, 6).Value = "Sector17CodeName"
ws.Cells(row, 7).Value = "Sector33Code"
ws.Cells(row, 8).Value = "Sector33CodeName"
ws.Cells(row, 9).Value = "ScaleCategory"
ws.Cells(row, 10).Value = "MarketCode"
ws.Cells(row, 11).Value = "MarketCodeName"

' データを書き込む
For i = 0 To UBound(InfoArray)
    Set Info = InfoArray(i)
    row = row + 1
    ws.Cells(row, 1).Value = Info("Date")
    ws.Cells(row, 2).Value = Info("Code")
    ws.Cells(row, 3).Value = Info("CompanyName")
    ws.Cells(row, 4).Value = Info("CompanyNameEnglish")
    ws.Cells(row, 5).Value = Info("Sector17Code")
    ws.Cells(row, 6).Value = Info("Sector17CodeName")
    ws.Cells(row, 7).Value = Info("Sector33Code")
    ws.Cells(row, 8).Value = Info("Sector33CodeName")
    ws.Cells(row, 9).Value = Info("ScaleCategory")
    ws.Cells(row, 10).Value = Info("MarketCode")
    ws.Cells(row, 11).Value = Info("MarketCodeName")
Next i

End Sub

このコードでは、まずJSONレスポンスの中から"info"というキーを持つ配列を取り出し、それぞれの要素を順に処理して各項目を取り出し、"output"シートに書き込んでいます。また、1行目には各項目のヘッダーを出力しています。最後に、行番号を管理するためのrow変数を使って、行を進めながらデータを書き込んでいます
-- 以上返答 ------------------

また型宣言のエラー

大丈夫そうな形で書き直して来ました。
正直、ここまで来るとChatGPTへの指示を考える方が難しいです（笑

ところで、また"key"の型宣言が抜けています。
ChatGPTさんは、keyの型宣言が嫌いなのでしょうか（笑

質問
key と InfoArray の変数が定義されていません。修正をお願いします。

返答
おっしゃる通りでした。以下の修正をお試しください。

Sub GetListedInfoRequest()
Dim HttpReq As Object
Dim Url As String
Dim IdToken As String
Dim Headers As Object
Dim Response As String
Dim Json As Object
Dim key As Variant

Set HttpReq = CreateObject("MSXML2.XMLHTTP")

Url = "https://api.jquants.com/v1/listed/info"
IdToken = "YOUR idToken"

Set Headers = CreateObject("Scripting.Dictionary")
Headers("Authorization") = "Bearer " & IdToken

HttpReq.Open "GET", Url, False
For Each key In Headers
    HttpReq.setRequestHeader key, Headers(key)
Next
HttpReq.send

Response = HttpReq.responseText
Set Json = JsonConverter.ParseJson(Response)

' info の配列を取得
Dim InfoArray As Variant
InfoArray = Json("info")

'出力先のワークシートを設定
Dim OutputSheet As Worksheet
Set OutputSheet = ThisWorkbook.Sheets("output")

'レコード毎に情報を出力
Dim Record As Variant
Dim i As Long
For Each Record In InfoArray
    OutputSheet.Cells(i + 1, 1) = Record("Date")
    OutputSheet.Cells(i + 1, 2) = Record("Code")
    OutputSheet.Cells(i + 1, 3) = Record("CompanyName")
    OutputSheet.Cells(i + 1, 4) = Record("CompanyNameEnglish")
    OutputSheet.Cells(i + 1, 5) = Record("Sector17Code")
    OutputSheet.Cells(i + 1, 6) = Record("Sector17CodeName")
    OutputSheet.Cells(i + 1, 7) = Record("Sector33Code")
    OutputSheet.Cells(i + 1, 8) = Record("Sector33CodeName")
    OutputSheet.Cells(i + 1, 9) = Record("ScaleCategory")
    OutputSheet.Cells(i + 1, 10) = Record("MarketCode")
    OutputSheet.Cells(i + 1, 11) = Record("MarketCodeName")
    i = i + 1
Next Record
End Sub

--- 以上返答 -------------------

さらに別のエラー

これを走らせると今度は別のエラーです。

質問
提案してもらったコードを走らせると、 InfoArray = Json("info") の部分で実行時エラー'450': 引数の数が一致していません。または不正なプロパティーを指定しています。とエラーになります。修正してください。

返答
申し訳ありません、修正漏れがありました。以下のコードで修正されるはずです。エラーが発生しなくなり、正常に動作するはずです。

Sub GetListedInfoRequest()
    Dim HttpReq As Object
    Dim Url As String
    Dim IdToken As String
    Dim Headers As Object
    Dim Response As String
    Dim Json As Object
    
    Set HttpReq = CreateObject("MSXML2.XMLHTTP")
    
    Url = "https://api.jquants.com/v1/listed/info"
    IdToken = "YOUR idToken"
    
    Set Headers = CreateObject("Scripting.Dictionary")
    Headers("Authorization") = "Bearer " & IdToken
    
    HttpReq.Open "GET", Url, False
    For Each key In Headers
        HttpReq.setRequestHeader key, Headers(key)
    Next
    HttpReq.send
    
    Response = HttpReq.responseText
    Set Json = JsonConverter.ParseJson(Response)
    
    Dim InfoArray As Variant
    InfoArray = Json("info")
    
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("output")
    
    Dim i As Long
    Dim j As Long
    Dim info As Object
    
    ' ヘッダー行を出力
    Dim header() As Variant
    header = Array("Date", "Code", "CompanyName", "CompanyNameEnglish", "Sector17Code", "Sector17CodeName", "Sector33Code", "Sector33CodeName", "ScaleCategory", "MarketCode", "MarketCodeName")
    ws.Range("A1:K1").Value = header
    
    ' 各レコードを出力
    For i = 0 To UBound(InfoArray)
        Set info = InfoArray(i)
        For j = 0 To 10
            ws.Cells(i + 2, j + 1).Value = info(header(j))
        Next j
    Next i
    
End Sub

--- 以上返答 -------------------

Json("info")というcollectionデータをvariant型のInfoArrayに代入するところを修正してありません。
これでは動きません。

自分で修正

これを正確に修正する様に質問するのが面倒になり、こちらでコードを動く様にしてしまいました（笑

Sub GetListedInfoRequest()
    Dim HttpReq As Object
    Dim Url As String
    Dim IdToken As String
    Dim Headers As Object
    Dim Response As String
    Dim Json As Object
    Dim key As Variant      ' keyを宣言する。
    
    Set HttpReq = CreateObject("MSXML2.XMLHTTP")
    
    Url = "https://api.jquants.com/v1/listed/info"
    ' IdTokenは、ワークシート上から取得のため、下の行に書き換える。
    'IdToken = "YOUR idToken"
    IdToken = Sheets("token").Cells(4, 2).Value
    
    Set Headers = CreateObject("Scripting.Dictionary")
    Headers("Authorization") = "Bearer " & IdToken
    
    HttpReq.Open "GET", Url, False
    For Each key In Headers
        HttpReq.setRequestHeader key, Headers(key)
    Next
    HttpReq.send
    
    Response = HttpReq.responseText
    Set Json = JsonConverter.ParseJson(Response)
    
    ' info の配列を取得
    Dim InfoArray As Variant
    ' 問題の行をコメントアウト
    'InfoArray = Json("info")
    
    '出力先のワークシートを設定
    Dim OutputSheet As Worksheet
    Set OutputSheet = ThisWorkbook.Sheets("output")
    
    'レコード毎に情報を出力
    Dim Record As Variant
    Dim i As Long
    'InfoArrayに代入していないので、Json("info")で書き換え。
    'For Each Record In InfoArray
    For Each Record In Json("info")
        OutputSheet.Cells(i + 1, 1) = Record("Date")
        OutputSheet.Cells(i + 1, 2) = Record("Code")
        OutputSheet.Cells(i + 1, 3) = Record("CompanyName")
        OutputSheet.Cells(i + 1, 4) = Record("CompanyNameEnglish")
        OutputSheet.Cells(i + 1, 5) = Record("Sector17Code")
        OutputSheet.Cells(i + 1, 6) = Record("Sector17CodeName")
        OutputSheet.Cells(i + 1, 7) = Record("Sector33Code")
        OutputSheet.Cells(i + 1, 8) = Record("Sector33CodeName")
        OutputSheet.Cells(i + 1, 9) = Record("ScaleCategory")
        OutputSheet.Cells(i + 1, 10) = Record("MarketCode")
        OutputSheet.Cells(i + 1, 11) = Record("MarketCodeName")
        i = i + 1
    Next Record
End Sub

１行コメントアウト、１行書き換えで済みました。

自分ではほとんど組まずに上場銘柄一覧をExcel VBAで取得することができました。

これは凄いですねー！！
世の中、ChatGPTで大騒ぎしている意味を実感できました。

因みに動く様にしてから指摘してみました。
質問
collection型のデータJson("info")をvariant型に入れるところでエラーになっていますから、入れ方をループ処理にするとかにしないと直らないのではないでしょうか。さらに言うとJson("info")を変数に入れる必要がないのではないですか。

返答
ご指摘いただいた通り、コードの修正が必要です。以下の修正案を提案いたします。

修正前のコード:

InfoArray = Json("info")

'ヘッダー出力
Dim key As Variant
Dim i As Integer
i = 1
For Each key In InfoArray(1)
    Sheets("output").Cells(1, i).Value = key
    i = i + 1
Next

'データ出力
Dim info As Object
Dim j As Integer
Dim k As Integer
For Each info In InfoArray
    j = 1
    For Each key In info
        Sheets("output").Cells(k + 2, j).Value = info(key)
        j = j + 1
    Next
    k = k + 1
Next

修正後のコード:

' ヘッダー出力
Dim headers As Object
Set headers = Json("info")(1)
Dim i As Integer
i = 1
For Each header In headers
    Sheets("output").Cells(1, i).Value = header
    i = i + 1
Next

' データ出力
Dim data As Object
Dim j As Integer
Dim k As Integer
k = 2 ' データ出力の開始行
For Each data In Json("info")
    j = 1
    For Each header In headers
        Sheets("output").Cells(k, j).Value = data(header)
        j = j + 1
    Next
    k = k + 1
Next

修正点としては、以下の通りです。

`InfoArray`の変数を削除し、直接`Json("info")`をループ処理で扱うように修正しました。
ヘッダーの取得方法を修正し、最初のレコードの情報を取得するようにしました。
データ出力時に行番号を初期化する代わりに、ループの前に`k = 2`で初期化しました。

--- 以上返答 -------------------

曖昧な質問に的確に返してきています。
本当にすごいですね。
脱帽です。

出来たExcel VBA をGithub に上ておきました。

https://github.com/boxalfa/J-Quants_Excel_VBA_ChatGPT_sample

ご笑覧ください。
ところで著作権はどうなるのでしょう。
連休後に調べてみます（笑

＊関連記事
Excel VBA で、J-Quants API に接続する記事です。
１）J-Quants API への接続をChatGPTに聞いてExcel VBAに書き直してみた
２）J-QuantsAPI をChatGPTに聞いてExcel VBAで書き直す（続き、銘柄リスト取得）
３）J-QuantsAPI をChatGPTに聞いてExcel VBAで書き直す（続き、銘柄リスト取得その2）
４）J-QuantsAPI のデータをExcelで取得する
（一応の完成形。フリープランの全機能をExcel VBA で実装しました。）

この記事が気に入ったらサポートをしてみませんか？

J-QuantsAPI をChatGPTに聞いてExcel VBAで書き直す（続き、銘柄リスト取得 その2）

出力部分も聞いてみる

データの形式を指定

また型宣言のエラー

さらに別のエラー

自分で修正

J-QuantsAPI をChatGPTに聞いてExcel VBAで書き直す（続き、銘柄リスト取得その2）