【ExcelVBA】OpenAIのAPI(GPT-3)を使用して表形式で情報収集する方法

3月 5, 20231月 12, 2024

OpenAIのAPIを使用してみたい人
OpenAIのAPIを使用して情報収集したい人向けに書いています。

本記事の内容

ExcelVBA（マクロ）でOpenAIのAPI（GPT-3「text-davinci-003」）を使用して表形式で情報収集する方法

OpenAIのAPI（GPT-3「text-davinci-003」）を使用して表形式で情報収集する方法

以下のようなExcelに、OpenAIのAPI（GPT-3「text-davinci-003」）を使用して表形式で情報を収集する方法を紹介します。
今回は会社の情報を収集してみます。

シートのA列に情報収集したい対象を入力し、1行目に情報収集したい対象の情報収集項目を入力するとその情報を自動で取得できるプログラムです。
会社情報以外にも他の情報収集でも試してみてください。

 
OpenAIのAPI（GPT-3「text-davinci-003」）を使用するにはOpenAIのアカウント作成とAPIキー発行が必要です。
以下で手順と方法を説明します。

OpenAIのアカウント作成

OpenAIのアカウント作成方法はこちらのリンクで説明しています。

OpenAIのAPIキー取得方法を解説《ChatGPTのAPI利用開始！「gpt-3.5-turbo」について》

OpenAIのAPI使用で必要なアカウント作成・ログイン・APIキー発行方法を画像付きで1ステップずつわかり ...

 https://808hanablog.com/explains-how-to-use-openai-api/#open...

OpenAIのAPIキー発行

OpenAIのAPIの発行方法はこちらのリンクで説明しています。

OpenAIのAPIキー取得方法を解説《ChatGPTのAPI利用開始！「gpt-3.5-turbo」について》

OpenAIのAPI使用で必要なアカウント作成・ログイン・APIキー発行方法を画像付きで1ステップずつわかり ...

 https://808hanablog.com/explains-how-to-use-openai-api/#open...

ExcelVBAでOpenAIのAPI（GPT-3「text-davinci-003」）を使用して表形式で情報収集するプログラム

本プログラムには「Microsoft XML v6.0」の参照設定が必要になります。

参照設定

１．ツールをクリックして、参照設定をクリックする

２．「Microsoft XML v6.0」にチェックしてOKボタンを押す

プログラム

今回のプログラムはGPT-3「text-davinci-003」のAPIを使用しています。

1. Sub GatInformation()
2.          
3.     Dim url As String 'リクエスト先URL
4.     Dim APIkey As String 'APIキー
5.     Dim KeyWord As String 'プロンプトキーワード
6.     Dim i As Long 'レコードカウント
7.     Dim j As Long '列カウント
8.     Dim k As Long '配列カウント
9.     Dim Proess_Start As Long 'セルスタート行
10.     Dim Proess_Sheet As String '処理対象シート
11.     Dim http As MSXML2.XMLHTTP60 'XMLHTTPオブジェクト
12.     Dim requestBody As String 'リクエスト文
13.     Dim strResponse As String 'リクエスト文テキスト文字列型
14.     Dim temp As Variant '
15.     Dim temp2 As Variant '
16.     
17.     
18.     'リクエスト先URL
19.     url = "https://api.openai.com/v1/completions "
20.     
21.     'APIキー
22.     APIkey = "発行したAPIキー"
23.    
24.     '処理対象シート
25.     Proess_Sheet = "Sheet1"
26.     
27.     'データ存在確認列
28.     Data_Exist_Cow = 1
29.     Data_Exist_Row = 1
30.     
31.     '処理開始行
32.     Proess_Start = 2
33.     
34.     With ThisWorkbook.Sheets(Proess_Sheet)
35.     
36.         'シートを上部から処理（データが存在する行まで処理）
37.         For i = Proess_Start To .Cells(Rows.Count, Data_Exist_Cow).End(xlUp).Row
38.             
39.             'シートを左から処理（データが存在する列まで処理）
40.             For j = Proess_Start To .Cells(Data_Exist_Row, Columns.Count).End(xlToLeft).Column
41.                 
42.                 '入力
43.                 KeyWord = .Cells(i, Data_Exist_Cow).Value & "の" & .Cells(Data_Exist_Row, j).Value & "を簡潔に端的に教えてください。見やすく書いてください。"
44.                 
45.                 'XMLHTTPオブジェクトをセット
46.                 Set http = New MSXML2.XMLHTTP60
47.                 
48.                 requestBody = "{""model"":""text-davinci-003"",""prompt"":""" & KeyWord & """,""max_tokens"":2000,""temperature"":0}"
49.                  
50.                 Call http.Open("POST", url, False)
51.                 Call http.setRequestHeader("Content-Type", "application/json")
52.                 Call http.setRequestHeader("Authorization", "Bearer " & APIkey)
53.                 Call http.send(requestBody)
54.                  
55.                 Do
56.                     If http.readyState = 4 Then Exit Do
57.                     DoEvents
58.                 Loop
59.                 
60.                 strResponse = http.responseText
61.                 
62.                 'Json形式データの回答テキストがある位置から分割
63.                 temp = Split(strResponse, "\n\n")
64.                     
65.                 '配列数を取得
66.                 intCount = UBound(temp)
67.                 
68.                 '配列分処理を繰り返す
69.                 For k = 1 To intCount
70.                         
71.                     If k = intCount Then
72.                         '最後の回答をセルに出力します。
73.                         temp2 = Split(temp(k), """,""")
74.                         .Cells(i, j).Value = Replace(Replace(temp2(0), "\n", Chr(10)), "\", "")
75.                     Else
76.                         '最後の回答以外をセルに出力します。
77.                         .Cells(i, j).Value = Replace(Replace(temp(k), "\n", Chr(10)), "\", "")
78.                     
79.                     End If
80.                         
81.                 Next k
82.                 
83.             Next
84.             
85.         Next
86.         
87.     End With
88.     
89. End Sub

実装内容

以下が実装の際に使用したインプットのシートです。

以下が実装後のアウトプットのシートです。

まとめ

ExcelVBAでOpenAIのAPI（GPT-3「text-davinci-003」）を使用して表形式で情報収集する方法を紹介しました。
最後までご覧いただき、ありがとうございました。

以下のリンクでChatGPTの始め方・登録（アカウント作成）方法、ログイン方法をまとめた記事を書いています。
もし、こちらも興味があればご覧ください。
→「【ChatGPT】始め方・登録（アカウント作成）方法、ログイン方法を解説《画像付き》」

ChatGPTの始め方・使い方を徹底解説《ChatGPTについてと活用方法を画像付きで日本語説

ChatGPTの始め方・登録（アカウント作成）方法、ログイン方法を解説します。登録やログインの手順を1ス ...

 https://808hanablog.com/how-to-start-chatgpt-and-register

以下のリンクで新しいBingチャットAIの始め方・使い方をまとめた記事を書いています。
もし、こちらも興味があればご覧ください。
→「【Bing】AIチャットの始め方・使い方を徹底解説《Microsoft版ChatGPT検索エンジンの使用方法》」

【Bing】AIチャットの始め方・使い方を徹底解説《Microsoft版ChatGPT！スマホアプリで

Microsoft BingのAIチャットの始め方・使い方を解説します。1ステップずつ画像付きで分かりやすく説明 ...

 https://808hanablog.com/explanation-of-how-to-start-and-use-...

他にも
「ハイブリッドワークにおすすめ便利・快適アイテム」
「オフィスワーカーがすべきWindowsPC設定」
「VBAでOutlookから自動メール送信する方法」
「【Amazon定期おトク便】おすすめ商品《日用品・食品・子育て用品》」
も紹介していますので、もしよろしければこちらもご覧ください。