2024/06/30 GPT-4oをデフォルトとするように修正しました。
窓の杜さんで、本ChatGPT関数の使用方法を詳細に解説いただきました。OpenAIのAPIを利用する手続きなは、次の記事を参考ください。
社会現象にもなっているopenAI社のChatGPT、Webサイトでブラウザから使用することができますし、プログラミングができればAPIを使って自作のシステムに組み込むこともできます。
だけど、もっと身近に使いたいんですよね。そう、いつも使っているExcel上で。
ということで、Excelのワークシート関数を使用する感覚でChatGPTを利用できるマクロを作成したので公開します。ExcelVBAでChatGPTのAPIをコールして質問をリクエスト、返ってくる回答文字列を取得するユーザー定義関数「ChatGPT」です。マクロと言ってもChatGPT関数を数式として入力するだけなので、実行ボタンなど押す必要もなく、vlookupなど通常の関数のように使用することができます。最新の大規模言語モデルAIを関数だけでワークシートに埋め込めるのですから、その使い方の可能性は無限大と言ってもよいでしょう。
さて、openAI社のChatGPT、2023年3月に最新のGPT-4が公開されましたが、今のところ利用は有償となるようです。無償でAPIを使えるモデルは「gpt-3.5-turbo」が最新、従来の3より高機能となり、目に見える機能差としては会話全体の役割を指示できるようになったことが挙げられます。具体的にはmessagesパラメータに新たなroleプロパティが追加されていて、role：systemとして、質問とは別に会話全体の役割を指定できるようになったのです。今回はこの最新版3.5-turboをExcelワークシートから使えるようにします。この「役割指示」が結構便利で、Excelワークシートでの使用と親和性が高いと思っており、その辺りは使用実例でお見せしたいと思いますが、まずはコードから。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 |
'------------------------------------------------------------- '指定した質問文字列をChatGPTにリクエストし回答文字列を取得する '2023/04/02 リリース '2023/05/07 文字列のエスケープ処理追加 '2024/06/30 更新 '------------------------------------------------------------- Option Explicit 'APIkeyの設定 Public Const apiKey As String = "" 'デフォルトモデルの設定 Public GPTmodel As String Function ChatGPT(text As String, _ Optional RoleSystem As String, _ Optional Temperature As Double = 0.4, _ Optional MaxTokens As Long = 2000, _ Optional Wait As Long = 60, _ Optional Model As String, _ Optional prevU As String, _ Optional prevA As String) As String ' 引数: ' 1. Text: モデルに対する主要な入力テキスト ' 2. RoleSystem (省略可能): アシスタントの動作を設定するシステムメッセージ ' 3. Temperature (省略可能): モデルの出力のランダム性 ' 4. MaxTokens (省略可能): レスポンスの最大トークン数 ' 5. Wait (省略可能): モデルのレスポンスを待つ最大時間（秒） ' 6. optModel (省略可能): 使用するGPTモデル gpt-3.5-turbo-0125,gpt-4o-2024-05-13 ' 7. PrevU (省略可能): 以前のユーザーメッセージ 新しい順に;;;区切り PrevUと同数推奨 ' 8. PrevM (省略可能): 以前のアシスタントメッセージ 新しい順に;;;区切り PrevAと同数推奨 'ChatGPTの設定 If Model = "" Then If GPTmodel <> "" Then Model = GPTmodel Else Model = "gpt-4o-2024-05-13" End If End If Const url = "https://api.openai.com/v1/chat/completions" '文字列内のエスケープ text = EscapeJSON(text) RoleSystem = EscapeJSON(RoleSystem) prevU = EscapeJSON(prevU) prevA = EscapeJSON(prevA) Dim msgPart As String, i As Long ' 以前のメッセージの構築 Dim maxLen As Long Dim arrPrevU() As String, arrPrevA() As String maxLen = -1 If prevU <> "" Then arrPrevU = Split(prevU, ";;;") maxLen = UBound(arrPrevU) End If If prevA <> "" Then arrPrevA = Split(prevA, ";;;") If maxLen < UBound(arrPrevA) Then maxLen = UBound(arrPrevA) End If If maxLen >= 0 Then '古い順に追加 For i = maxLen To 0 Step -1 If i <= UBound(arrPrevU) Then msgPart = msgPart & "{""role"":""user"",""content"":""" & arrPrevU(i) & """}," End If If i <= UBound(arrPrevA) Then msgPart = msgPart & "{""role"":""assistant"",""content"":""" & arrPrevA(i) & """}," End If Next i End If 'RoleSystemの構築 If RoleSystem <> "" Then msgPart = "{""role"":""system"",""content"":""" & RoleSystem & """}," & msgPart '直近の会話の構築 msgPart = msgPart & "{""role"":""user"",""content"":""" & text & """}" 'リクエストボディの構築 Dim body As String, Rspns As String body = "{" & _ """model"":""" & Model & """," & _ """messages"":[" & msgPart & "]," & _ """max_tokens"":" & MaxTokens & "," & _ """temperature"":" & Temperature & "," & _ """top_p"":1" & _ "}" Debug.Print body リクエスト開始: Dim Xmlhttp As Object Set Xmlhttp = CreateObject("MSXML2.XMLHTTP") With Xmlhttp .Open "POST", url '非同期 'ヘッダー設定 .setRequestHeader "Content-Type", "application/json" .setRequestHeader "Authorization", "Bearer " & apiKey 'リクエスト .send body '待機開始 Dim StartTime StartTime = Timer Do DoEvents If Xmlhttp.readyState = 4 Then Exit Do If Timer - StartTime > Wait Then Debug.Print "◆" & Wait & "秒レスポンスがないため再リクエストします" Set Xmlhttp = Nothing GoTo リクエスト開始 End If Loop 'レスポンステキストを出力 Rspns = .responseText Debug.Print Left(Rspns, 400) End With 'JSONのパース用変数 Dim p1 As Long, p2 As Long '文字位置 Dim str1 As String, str2 As String '検索文字列 Dim temp As String ' 判断用の文字列をセット If InStr(Rspns, Chr(34) & "error" & Chr(34) & ": {") > 0 Then str1 = "message" & Chr(34) & ": " & Chr(34) str2 = Chr(34) & "," & vbLf Else str1 = "content" & Chr(34) & ": " & Chr(34) str2 = Chr(34) & vbLf & " }," End If ' 開始・終了位置を取得 p1 = InStr(Rspns, str1) + Len(str1) p2 = InStr(p1 + 1, Rspns, str2) - p1 'JSONからテキストを抽出 temp = Mid(Rspns, p1, p2) temp = UnescapeJSON(temp) ChatGPT = temp End Function 'JSONで解釈できるようVBA特殊文字をエスケープ Function EscapeJSON(S As String) As String Dim i As Integer S = Replace(S, "\", "\\") ' バックスラッシュ S = Replace(S, "/", "\/") ' スラッシュ S = Replace(S, Chr(8), "\b") ' vbBack: バックスペース S = Replace(S, Chr(9), "\t") ' vbTab: 水平タブ S = Replace(S, Chr(10), "\n") ' vbLf: ラインフィード S = Replace(S, Chr(11), "\t") ' vbVerticalTab: 垂直タブ S = Replace(S, Chr(12), "\f") ' vbFormFeed: フォームフィード S = Replace(S, Chr(13), "\r") ' vbCr: キャリッジリターン S = Replace(S, Chr(34), "\" & Chr(34)) ' ダブルクォート S = Replace(S, vbNewLine, "\n") ' vbNewLine: 環境に応じた改行記号 'JSONで許可されていないASCII のコントロールコード (0x00 から 0x1F) を削除 For i = 0 To 31 If i < 8 Or i > 13 Then 'エスケープ済み以外 S = Replace(S, Chr(i), "") End If Next i EscapeJSON = S End Function 'VBAで扱えるようJSON特殊文字をエスケープ Function UnescapeJSON(S As String) As String S = Replace(S, "\\", "\") ' バックスラッシュ S = Replace(S, "\/", "/") ' スラッシュ S = Replace(S, "\b", Chr(8)) ' vbBack: バックスペース S = Replace(S, "\t", Chr(9)) ' vbTab: 水平タブ S = Replace(S, "\n", Chr(10)) ' vbLf: ラインフィード S = Replace(S, "\f", Chr(12)) ' vbFormFeed: フォームフィード S = Replace(S, "\r", Chr(13)) ' vbCr: キャリッジリターン S = Replace(S, "\" & Chr(34), Chr(34)) ' ダブルクォート S = Replace(S, "\u0026", "&") ' アンバサンド S = Replace(S, "\u003c", "<") ' レスザン S = Replace(S, "\u003e", ">") ' グレーターザン UnescapeJSON = S End Function Sub SetGPTmodel() Dim MyRtn, n MyRtn = InputBox("Chat-GPTのモデルを設定してください" & vbCrLf & _ " 1：gpt-4o-2024-05-13" & vbCrLf & " 2：gpt-3.5-turbo-0125", "OpenAI") n = Val(StrConv(MyRtn, vbNarrow)) If IsNumeric(n) Then If n = 1 Then GPTmodel = "gpt-4o-2024-05-13" ElseIf n = 2 Then GPTmodel = "gpt-3.5-turbo-0125" End If End If If GPTmodel = "" Then MsgBox "Chat-GPTのモデルが指定されていません", , "OpenAI" Else MsgBox "Chat-GPTのモデルが「" & GPTmodel & "」に指定されました", , "OpenAI" End If End Sub |
使用するには、ワークブックにモジュールを一つ挿入して、そこに上記コードをペタッと張り付ければOKです。マクロを有効にするとChatGPT関数が使用できます。（事前にopenAIのWebサイトからAPIKeyを取得、コードの apiKey = “” に記述してください。）
使い方は簡単、＝ChatGpt(B$2,$A3)のようにセルに数式として入力し使用します。この場合、B2セルに質問内容を入力、A3セルに会話全体の役割を指示します。次の使用例を見ていただければ、イメージいただけると思います。
会話全体の指示どおり、ChatGPTが回答してくれています。実際の数式はこんな感じです。他のセルの数式も、この数式をコピーするだけです。
他の役割事例も紹介しましょう。これまた指示どおり、役割を演じて回答してくれていますね。
いやはや、ChatGPT、すごいです・・・。
次に、表計算ワークシートならではのChatGPT活用方法もご紹介しましょう。都道府県別の様々な代表物を取得する例ですが、このように対象単位に何かしらの情報を一覧で取得したい際に非常に有効です。
このようなマトリクスを作り、縦横のタイトル文字列を参照して質問文を生成、この場合「北海道の代表的な花を一つ教えてください」という質問をChatGPTに投げていることになりますが、セルの絶対参照をうまく使うことで、この数式をそのまま他のセルにコピーして使いまわせるわけです。
でも、回答は文章で返ってくるので長いんですよね。もっと端的にデータベースっぽいのを作りたい場合にも、ChatGPT関数の第二引数「会話全体の役割指示」が役立ちます。次のように指定することで、望んでいる結果に近い回答文字列が得られるようになります。B2セルにひたすら指示を書き込み、それをChatGPT関数の第二引数に指定しています。
まあ、完璧に言うことを聞いてくれるわけではないのですが、指定するのとしないのとでは雲泥の差があり、この指定の仕方、いわゆる「AIプロンプト作成力」が問われる時代が来ている気もします。また、ChatGPTの回答内容が正しいかどうかは不明であり、虚偽の情報が含まれている可能性が多分にあることを理解したうえで活用する必要があることは言うまでもありません。
最後に使用上の注意点を。このようにChatGPT関数は、ワークシート上で自在にChatGPTを使用できて便利なのですが、計算する際にはAPIコールによるネット通信が発生します。よって結果が返ってくるまでに、それなりの時間がかかるため、一覧表など複数のセルでChatGPT関数を使用する場合はExcelの設定を手動計算にしておき、数式の入力が完了した後「F9」キーで一気に再計算！という使用方法がよいかもしれません。
【2023/04/18 追記】
窓の杜さんで、本マクロの使用方法を詳細に解説いただきました！
またその後、当ブログで追加記事をエントリーしていますので、こちらもご参考ください
それでは良いVBAライフを！
コメント