1. 本記事の内容
「第３回金融データ活用チャレンジ」 に参加しました。コンペの内容は、企業のESGレポートや統合報告書に関連する質問に対して自動的かつ正確に回答できるRAG（Retrieval-Augmented Generation）を構築し、その回答の精度を競うことです。
その際に、エクセルVBAでAzure OpenAIのRAGによるナレッジ検索を、ベクトルDBを作成するところから実装しましたので取り組みを紹介します。
以下の方に少しでも有用な記事になれたら嬉しいです
- VBAでRestAPIを扱う方法を知りたい方
- RAGを実務で活用したい方
2. RAGについて
RAGとは
大量のデータから関連情報を検索し、AIがそれを活用して回答を生成する仕組みです。
RAGの重要性
生成AIは最新情報や特定のドメイン知識が不足することがあるため、検索機能を組み合わせることで回答の精度を向上させられるRAGはとても重要です。
3. エクセルVBAでの実装を考えた理由
-
企業の現場ではエクセルが圧倒的に使われていること
多くの企業がエクセルを利用しており、自社でも業務の中心になっています。
新しいツールを導入するよりも、まずは既存のエクセル環境にAIを組み込む方が始めやすいですし、より活用の促進が図れると思ったからです。
-
単純にエクセルが好き！
💖 エクセルに出会えて20年弱ですが、その奥深さは未だに計り知れません。
尽きせぬ魅力の探求は、もはやライフワークだと思い込んでいます。💘 PCで出来ることはすべてエクセルでできると信じてやってきました。
❤️🔥 出来ないことがあっても、それはエクセルではなく、まだ私が出来ないだけです
ので日々スキルアップを目指してます。
4. RAGの仕組み
全体の流れはざっくり以下の通りです
- 参照すべきデータからベクトルDBを作成（エンベッディング）
- クエリ（質問文）をベクトル化
- 2のベクトルと類似するものを1のベクトルDBから検索
- 検索結果を基に最適な回答を生成
今回の第３回金融データ活用チャレンジではマイクロソフト様からAzure OpenAI（以下、AOAI）のAPIキーをお借りできましたので、上記1,2,4にAOAIを活用する訳ですが、それぞれのフェーズをエクセルVBAでコーディングします。
5. 実装手順
🔹 エクセルVBAの設定
以下のDLLに参照設定からチェックを入れます。コード内のCreateObjectでもOKです。
- 主だったDLLの内容は以下の通りです。
-
Microsoft ActiveX Data Objects 6.1 Library
今回の取り組みではバイト配列やutf-8 の扱いが楽になります。 -
Microsoft Scripting Runtime
ファイルの取り回しが楽になりますし、Dictionaryは必須となります。 -
Microsoft WinHTTP Services, version5.1
HTTPリクエストの送受信が楽になります。
-
AOAIとのやり取りは基本的にJSONフォーマットで行うのでVBA-JSONを使うと更にものすごく楽になるんですが、自社業務への活用を考えた場合、勝手に外部モジュールのインポートは出来ない為、断腸の思いで諦めました。必要な関数群を泥臭く自作します。
というか、もしかしたらAOAIをエクセルで扱えるDLLなんかもあるかもしれないと思いつつ、今回はどうせなので環境に新たなインポートやインストールはせずに取り組みます。
またエクセルのバージョンは2016です。
🔹 AOAIの設定
AOAIのエンドポイントやモデル名、バージョン、APIキーを用意してください。
今回はマイクロソフト様からご提供頂けましたので、私でやることは特にありませんでしたが、取り扱いには十二分に注意します。
認証情報の取り扱いには本当に細心の注意を払って下さい。
またAOAIをAPIで利用すると1回あたりはごくわずかながらお金がかかりますので、ご利用は計画的に行って下さい。
🔹 5.1 参照すべきデータからベクトルDBを作成（エンベッディング）
- 参照すべきデータを用意
コンペでは19社のESGや統合報告書がありますが、まずは小規模に構築する為に
今回は株式会社4℃ホールディングス様の統合報告書を使用させて頂きました。
PDFで14ページあります。
PythonのpymupdfでPDFをダイレクトにテキスト化するのも中々良さげだった一方、スタイルが崩れがちなのと画像は読み込めないので一部の情報が欠落することから、pymupdfで１ページずつ画像化した上でClaude3.5 sonnetのAPIで読み込んでテキスト化し、さらに内容をJSONに整形しました。
あくまで一例ですが、当該統合報告書の2ページ目のJSONは以下のようになっております。ぱっと見かなり良い感じにテキスト化できています。長いので内容を一部省略しています。
JSONの例
{
"filename": "1_002.json",
"会社名": "株式会社4℃ホールディングス",
"content": {
"テキスト": "水は自由奔放にその姿を変えていきます。(略)",
（中略）
"企業文化": "人間尊重の基本理念のもと変革を恐れず挑戦し続ける企業文化を大切にします。",
"業績": {
"売上高": "394.5億円（前期比△0.1%）",
"営業利益": "20.9億円（前期比+5.9%）",
"当期純利益": "13.0億円（前期比+13.2%）",
"ブランド事業": {
"ジュエリーブランド数": "6ブランド",
"店舗数": "136店舗",
"会員数": "115万人",
"事業の強み": [
"４℃ホールディングスグループの成長牽引事業と位置づけ",
"ジュエリーの商品企画・デザインから製造・販売までを一貫して手がけるSPA",
"100万人の顧客基盤"]
},
"連結子会社数": "7社",
"従業員数(連結)": "1,003名",
"年間教育研修総時間": "27,398時間",
"年間教育研修費": "40.9百万円"
}
}
}
後で検索するためにfilenameと会社名のキーを付与しています。ページの内容はcontentキーの中に階層構造で格納しています。
実は私も今回初めてRAG構築にチャレンジしましたので、どうすれば良いか分からないなりに、JSONにするべしとの噂を小耳に挟んだので真似をしました。 またこの例にはありませんが、metadataキーを付与してファイル内容の詳細な情報を与えたりしました。この辺りの整形についてはひたすらに試行錯誤を繰り返しており未だに答えがでていません。
第３回金融データ活用チャレンジでは19のPDFファイルがあり、それぞれページごとに画像のテキスト化⇒整形をClaudeで行った結果、1周あたり約20㌦かかった為大事に使います。
ちなみに私は若い頃に宝石貴金属の販売員をしており、デパートの同じフロアに4℃様のお店がありました。20年以上前の当時から同業者の中でもオシャレな企業としての立ち位置を確立されていました。
-
上記で作成した14のJSONファイルをAOAIのEmbeddingAPIを使い、ベクトル表にします（エンベッディング）
まずはAOAIにリクエストを送る際のリクエストボディを、{"input": [contentの値]} にする必要があるので、整形したJSONからcontentの値を取得してVBAの辞書にするParse_Json関数を作りました。以下に記載します。
Parse_Json関数
Public Function Parse_Json(json_moji As String) As Object
Dim json As New Scripting.Dictionary
Dim content_Start As Long, contentEnd As Long, braceCount As Long, i As Long
Dim content_moji As String
content_Start = InStr(json_moji, """content"": {") + Len("""content"": {") ' content部分の開始と終了位置を特定
braceCount = 1 ' 開始の { があるので1から始める
For i = content_Start To Len(json_moji)
Select Case Mid(json_moji, i, 1)
Case "{"
braceCount = braceCount + 1
Case "}"
braceCount = braceCount - 1
If braceCount = 0 Then
contentEnd = i
Exit For
End If
End Select
Next i
If content_Start > 0 And contentEnd > 0 Then
' content部分の文字列を取得
content_moji = Mid(json_moji, content_Start, contentEnd - content_Start)
' 改行やタブを半角スペースにする
content_moji = Replace(Replace(content_moji, vbCrLf, " "), vbTab, " ")
Do While InStr(content_moji, " ") > 0 ' 連続する空白を1つにまとめる
content_moji = Replace(content_moji, " ", " ")
Loop
json("content") = content_moji 'json辞書のcontentキーの値がパースした文字列
End If
Set Parse_Json = json
End Function
次にリクエストを受け取ったAOAIからのレスポンスを処理する関数を作ります。以下がレスポンスの構造です。
embeddingのレスポンス例
{
"data": [
{
"embedding": [0.03175894170999527, 0.006807597354054451, 0.003905877470970154, "（略）"],
"model": "text-embedding-3-large",
"object": "list",
"usage": {
"prompt_tokens": 16,
"total_tokens": 16
}
}
]
}
関数を2段階に分けます。
1段階目：レスポンスの中のマルチバイト文字はバイト配列で返ってくるため、UTF8に変換する
2段階目：UTF8に変換したレスポンスをパースして、embeddingの値を取得する
受け取ったバイト配列をUTF8に変換する、Bytes_2_Utf8関数を作りました。
embeddingのレスポンスはマルチバイト文字が含まれないと思われるんですが、チャットのレスポンスの処理に使用する為ここで作っておいて、念の為にエンベッディングにも使用します。
Bytes_2_Utf8関数
Public Function Bytes_2_Utf8(ByRef bytes() As Byte) As String
Dim ado As New ADODB.Stream
Dim buf As String
With ado
.Type = 1 ' バイナリモード
.Open
.Write bytes
.Position = 0
.Type = 2 ' テキストモード
.Charset = "utf-8" ' UTF-8として読み込む
buf = ado.ReadText
.Close
End With
Bytes_2_Utf8 = buf
End Function
受け取ったJSONをパ－スしてembeddingキーの値を取得する、Json_Get_Embedding関数を作ります。
Json_Get_Embedding関数
Public Function Json_Get_Embedding(ByVal json_str As String) As String
Dim s_posi As Long, e_posi As Long
Dim embedding As String
' "embedding": [ の位置を見つける
s_posi = InStr(json_str, """embedding"": [") + Len("""embedding"": [")
If s_posi > 0 Then
' 配列の終わり "] を見つける
e_posi = InStr(s_posi, json_str, "]")
If e_posi > s_posi Then
' 配列部分を抽出
embedding = Mid$(json_str, s_posi, e_posi - s_posi)
' 空白と改行を削除
embedding = Replace(Replace(Replace(embedding, " ", ""), vbCrLf, ""), vbLf, "")
' 最終的な配列形式に整形
embedding = "[" & embedding & "]"
Else
embedding = "エンベッディング終了位置が見つかりませんでした。"
End If
Else
embedding = "エンベッディング開始位置が見つかりませんでした。"
End If
Json_Get_Embedding = embedding
End Function
- 以上の関数をCreate_Embeddingsプロシージャの中で組み合わせて、14のJSONファイルを1つのベクトルDBにします。
対象となるJSONのパスは、GetOpenFilenameで動的に取得するようにしています。
ステータスバーで進捗も表示するようにしました。
作成したベクトルDBは、ThisWorbook.Path に、vectors_yyyymmddhhmm.csv のファイル名で保存されます。
Create_Embeddingsプロシージャ
Public Sub Create_Embeddings()
Dim fso As New Scripting.FileSystemObject
Dim json_obj As New Scripting.Dictionary
Dim ado As New ADODB.Stream
Dim req As New WinHttp.WinHttpRequest
Dim input_files As Variant
Dim output_file As String, embedding As String, json_content As String, res_text As String, req_body As String
Dim csv_num As Long, i As Long
' エンベディングAPIの設定
Const EMBEDDING_URL As String = "エンベッディングAPIのエンドポイント等の情報を指定します"
Const api_key As String = "APIキーを指定します"
' ファイル選択ダイアログを表示
input_files = Application.GetOpenFilename("JSONファイル (*.json),*.json", Title:="エンベディング対象のJSONファイルを選択してください", MultiSelect:=True)
If VarType(input_files) = vbBoolean Then Exit Sub
output_file = ThisWorkbook.Path & "\vectors_" & Format(Now, "yyyymmdd_hhmm") & ".csv"
csv_num = FreeFile
Open output_file For Output As #csv_num
' ヘッダーの書き込み
Print #csv_num, "filename,embedding"
' 各ファイルを処理
For i = LBound(input_files) To UBound(input_files)
' 進捗表示をステータスバーに表示
Application.StatusBar = "処理中: " & i - LBound(input_files) + 1 & "/" & UBound(input_files) & ": " & fso.GetFileName(input_files(i))
With ado
.Charset = "UTF-8"
.Type = adTypeText
.Open
.LoadFromFile input_files(i)
json_content = .ReadText
.Close
End With
' JSONからcontent抽出
Set json_obj = Parse_Json(json_content)
If json_obj.Exists("content") = True Then
Dim content As String
content = json_obj("content")
content = Replace(content, """", "\""")
content = Replace(content, vbCrLf, " ") ' 改行を空白に置換
' リクエストボディの作成
req_body = "{""input"": [""" & content & """]}"
On Error GoTo ErrorHandler
With req ' エンベディングAPIの呼び出し
.Open "POST", EMBEDDING_URL, False
.setRequestHeader "Content-Type", "application/json"
.setRequestHeader "api-key", api_key
.Send req_body
' レスポンスの確認
If .Status = 200 Then
res_text = bytes_2_utf8(.ResponseBody) 'レスポンスはバイト配列で返ってくるのでUTF8に変換
embedding = json_get_embedding(res_text) ' ベクトルの抽出
' ファイル名とベクトルの2列のレコードをcsvファイルに書き込む。ヘッダーはfilename,embedding
Print #csv_num, fso.GetFileName(input_files(i)) & ",""" & embedding & """"
Application.Wait Now + TimeValue("00:00:03") ' API呼び出しの間に3秒待機する（とても大事）
Else
Debug.Print "ファイル " & fso.GetFileName(input_files(i)) & " の処理に失敗しました。ステータス: " & .Status
End If
End With
Else
Debug.Print "ファイル " & fso.GetFileName(input_files(i)) & " にcontentが含まれていません。"
End If
Set json_obj = Nothing
Set ado = Nothing
Next i
' ステータスバーをクリア
Application.StatusBar = False
MsgBox "すべてのファイルの処理が完了しました。" & vbCrLf & "ベクトルDB: " & output_file
CleanUp:
Close #csv_num
Set fso = Nothing
Application.StatusBar = False
Exit Sub
ErrorHandler:
MsgBox "エラーが発生しました: " & Err.Description & vbCrLf & _
"ファイル: " & fso.GetFileName(input_files(i)), vbCritical
Resume CleanUp
End Sub
これでベクトルDBが作れるようになりました。
🔹 5.2 クエリ（質問）をベクトル化
クエリをベクトル化する、Get_Query_Embedding関数を作成します。
Get_Query_Embedding関数
Public Function Get_Query_Embedding(ByVal text As String, ByVal url As String, ByVal api_key As String) As Variant
Dim req As New WinHttp.WinHttpRequest
Dim req_body As String, res_text As String
Dim vec As Variant
req_body = "{""input"":[""" & Replace(text, """", "\""") & """]}"
With req
.Open "POST", url, False
.setRequestHeader "Content-Type", "application/json"
.setRequestHeader "api-key", api_key
.Send req_body
If .Status = 200 Then
res_text = bytes_2_utf8(.ResponseBody)
' レスポンスからエンベディングベクトルを抽出
vec = Embedding_From_Response(res_text)
Get_Query_Embedding = vec
Else
Debug.Print "Error Status: " & .Status
Debug.Print "Error Response: " & bytes_2_utf8(.ResponseBody)
Err.Raise 500, "GetEmbedding", "API呼び出しに失敗しました。Status: " & .Status
End If
End With
End Function
Get_Query_Embedding関数の中の処理で、レスポンスからembeddingの値を抽出する為のEmbedding_From_Response関数を作成します。先ほどのJson_Get_Embedding関数とよく似た動きですが、Json_Get_Embedding関数は返り値がStringで、Embedding_From_Response関数はVariantとなっています。1つの関数にまとめられそうですが、ちょっと大変そうなのでいったんスルーします。
Embedding_From_Response関数
Public Function Embedding_From_Response(ByVal res_text As String) As Variant
Dim s_posi As Long, e_posi As Long, i As Long
Dim embedding_str As String
Dim embedding_arr As Variant, vec() As Double
s_posi = InStr(res_text, """embedding"": [") + Len("""embedding"": [")
If s_posi = Len("""embedding"": [") Then
s_posi = InStr(res_text, """embedding"":[") + Len("""embedding"":[")
End If
If s_posi > 0 Then
e_posi = InStr(s_posi, res_text, "]")
If e_posi > s_posi Then
embedding_str = Mid(res_text, s_posi, e_posi - s_posi)
embedding_arr = Split(embedding_str, ",")
' 数値配列に変換
ReDim vec(LBound(embedding_arr) To UBound(embedding_arr))
For i = LBound(embedding_arr) To UBound(embedding_arr)
vec(i) = CDbl(Trim(embedding_arr(i)))
Next i
Embedding_From_Response = vec
Else
Err.Raise 500, "ParseEmbeddingFromResponse", "エンベッディング終了位置が見つかりません"
End If
Else
Err.Raise 500, "ParseEmbeddingFromResponse", "エンベッディング開始位置が見つかりません"
End If
End Function
これでクエリをベクトル化できます。
🔹 5.3 クエリのベクトルと類似するものをベクトルDBから検索
ベクトル同士のコサイン類似度を計算するCosine_Similarity関数を作成します。
Cosine_Similarity関数
Public Function Cosine_Similarity(ByVal vec_a As Variant, ByVal vec_b As Variant) As Double
Dim dot_product As Double, norm_a As Double, norm_b As Double
Dim i As Long
dot_product = 0
For i = LBound(vec_a) To UBound(vec_a)
dot_product = dot_product + vec_a(i) * vec_b(i)
Next i
norm_a = 0: norm_b = 0
For i = LBound(vec_a) To UBound(vec_a)
norm_a = norm_a + vec_a(i) * vec_a(i)
norm_b = norm_b + vec_b(i) * vec_b(i)
Next i
norm_a = Sqr(norm_a)
norm_b = Sqr(norm_b)
If norm_a * norm_b = 0 Then
Cosine_Similarity = 0
Else
Cosine_Similarity = dot_product / (norm_a * norm_b)
End If
End Function
今回のベクトルDBは14レコードあります。それぞれが読み込んだJSONに対応しており、クエリのベクトルとの類似度を計算させるわけですが、類似度の高いものを抽出して参照する為にGet_Top_SimilarDocs関数を作成します。
計算させた類似度を配列に格納してバブルソートで並び替えています。バブソは簡単に実装できる反面、レコードが増えると計算量はガンガンに増加していく（最大でレコード数の2乗）ので、ここも改善点ですね。また上位のk件は引数で指定できるようにしておきます。
Get_Top_SimilarDocs関数
Public Function Get_Top_SimilarDocs(ByVal query_embedding As Variant, ByVal vector_data As Collection, ByVal top_k As Long) As Collection
Dim results As New Collection
Dim similarities() As Variant, current_vec As Variant
Dim i As Long, j As Long, temp_idx As Long
Dim temp_sim As Double
ReDim similarities(1 To vector_data.count, 1 To 2)
' 各文書との類似度を計算
For i = 1 To vector_data.count
current_vec = vector_data(i)("embedding")
similarities(i, 1) = i ' インデックス
similarities(i, 2) = cosine_similarity(query_embedding, current_vec)
Next i
' バブルソートで並び替え
For i = 1 To UBound(similarities) - 1
For j = 1 To UBound(similarities) - i
If similarities(j, 2) < similarities(j + 1, 2) Then
temp_idx = similarities(j, 1)
similarities(j, 1) = similarities(j + 1, 1)
similarities(j + 1, 1) = temp_idx
temp_sim = similarities(j, 2)
similarities(j, 2) = similarities(j + 1, 2)
similarities(j + 1, 2) = temp_sim
End If
Next j
Next i
' 上位k件を結果に追加
For i = 1 To Application.Min(top_k, UBound(similarities))
results.Add vector_data(CInt(similarities(i, 1)))
Next i
Set Get_Top_SimilarDocs = results
End Function
保存したベクトルDBのembedding列のベクトルはカンマ区切りとなっており読み込む際に一工夫必要になりますので、Load_Vector_Data関数も作ります。
ベクトルDBをGetOpenFilename関数で取得して、辞書が要素のCollectionとして返す関数です。
今さらですがタブ区切りとかにしてたらもっと楽になったはずなのでこちらも改善点です。
Load_Vector_Data関数
Public Function Load_Vector_Data() As Collection
Dim doc As New Scripting.Dictionary
Dim data As New Collection
Dim ado As New ADODB.Stream
Dim vector_file As Variant, values As Variant
Dim headers As String, line_str As String, f_name As String, embedding_str As String
Dim doc_count As Long, pos As Long, i As Long
Dim vec() As Double
vector_file = Application.GetOpenFilename("CSVファイル (*.csv),*.csv", "ベクトルデータファイルを選択してください")
If VarType(vector_file) = vbBoolean Then
MsgBox "ファイルが選択されませんでした。"
Set Load_Vector_Data = data
Exit Function
End If
With ado
.Charset = "UTF-8"
.Type = adTypeText
.Open
.LoadFromFile vector_file
headers = .ReadText(adReadLine) ' ヘッダー行はスキップする
doc_count = 0
Do Until .EOS
line_str = .ReadText(adReadLine)
doc_count = doc_count + 1
pos = InStr(1, line_str, ",""[") ' embedding開始位置を探す
If pos > 0 Then
f_name = Left(line_str, pos - 1)
embedding_str = Mid(line_str, pos + 2) ' カンマと引用符をスキップ
embedding_str = Left(embedding_str, Len(embedding_str) - 1) ' 末尾の引用符を除去
embedding_str = Mid(embedding_str, 2, Len(embedding_str) - 2) ' 角括弧を除去
values = Split(embedding_str, ",")
ReDim vec(LBound(values) To UBound(values)) ' 数値配列に変換
For i = LBound(values) To UBound(values)
vec(i) = CDbl(Trim(values(i)))
Next i
doc("filepath") = f_name ' 辞書に追加
doc("embedding") = vec
data.Add doc ' コレクションに追加
End If
Set doc = Nothing
Loop
.Close
End With
Set Load_Vector_Data = data
End Function
🔹 5.4 検索結果を基に最適な回答を生成
いよいよ大詰めです。
チャットに投げるコンテキストに類似度が高いJSONを読み込んで中身を追加していく、Build_Context関数を作成します。構築したコンテキストと読み込んだファイル名を返します。
Build_Context関数
Public Function Build_Context(top_docs As Collection) As String
Dim fso As New Scripting.FileSystemObject
Dim ado As New ADODB.Stream
Dim context As String, doc_path As String, f_names As String
Dim i As Long
Const JSON_PATH As String = "参照したいJSONファイルの場所を指定"
context = ""
For i = 1 To top_docs.count
doc_path = JSON_PATH & fso.GetFileName(top_docs(i)("filepath")) ' ファイル名のみを取得してパスを再構築
If f_names = "" Then
f_names = fso.GetFileName(top_docs(i)("filepath"))
Else
f_names = f_names & "、" & fso.GetFileName(top_docs(i)("filepath"))
End If
If fso.FileExists(doc_path) = True Then
With ado
.Charset = "UTF-8"
.Type = adTypeText
.Open
.LoadFromFile doc_path
' コンテキストに追加
context = context & vbCrLf & _
"=== ソース: " & fso.GetFileName(doc_path) & " ===" & vbCrLf & _
.ReadText & vbCrLf
.Close
End With
Else
Debug.Print "警告: ファイルが見つかりません: " & doc_path
End If
Next i
Build_Context = context & "∬" & f_names
End Function
次にチャットとやり取りをするGet_Chat_Response関数を作成します。
チャットに投げるプロンプトで精度はかなり変わってきます。いったんオーソドックスな感じにします。
Get_Chat_Response関数
Public Function Get_Chat_Response(ByVal query As String, ByVal context As String, ByVal url As String, ByVal API_KEY As String) As String
Dim req As New WinHttp.WinHttpRequest
Dim system_content As String, req_body As String, user_content As String, res_text As String
system_content = "あなたは優秀なAIアシスタントです。ユーザーが与えた情報だけをもとに回答してください。答えはシンプルに体言止めでお願いします。"""
user_content = "以下のコンテキストのみを参考に回答をしてください。" & vbCrLf & _
"質問:" & vbCrLf & query & vbCrLf & vbCrLf & _
"コンテキスト:" & vbCrLf & context
' リクエストボディの作成 - 改行とダブルクォートの処理を修正
req_body = "{""messages"":[" & _
"{""role"":""system"",""content"":""" & Replace(Replace(system_content, vbCrLf, "\n"), """", "\""") & """}," & _
"{""role"":""user"",""content"":""" & Replace(Replace(user_content, vbCrLf, "\n"), """", "\""") & """}]," & _
"""model"":""gpt-4""," & _
"""temperature"":0.7," & _
"""max_tokens"":4000," & _
"""top_p"":0.95," & _
"""frequency_penalty"":0," & _
"""presence_penalty"":0}"
With req
.Open "POST", url, False
.setRequestHeader "Content-Type", "application/json"
.setRequestHeader "api-key", API_KEY
.Send req_body
If .Status = 200 Then
res_text = Bytes_2_Utf8(.ResponseBody)
Get_Chat_Response = Extract_Response(res_text)
Else
Debug.Print "Error Status: " & .Status
Debug.Print "Error Response: " & Bytes_2_Utf8(.ResponseBody)
Get_Chat_Response = "エラーが発生しました。Status: " & .Status
End If
End With
End Function
更にチャットとやり取りする際のAOAIからのレスポンスをパースする、Extract_Response関数を作成します。 AOAIのレスポンスをパースする関数はこれで3個目になります。本当はぜんぶを1つにまとめた方が良いのはわかってますが、けっこう大変そうですのでいったんスルーです。
Extract_Response関数
Public Function Extract_Response(ByVal res_text As String) As String
Dim s_posi As Long
Dim e_posi As Long
Dim content As String
s_posi = InStr(res_text, """message"":{""content"":""") + Len("""message"":{""content"":""")
If s_posi > 0 Then
e_posi = s_posi
Do
e_posi = InStr(e_posi + 1, res_text, """")
' エスケープされていないダブルクォートを見つけるまで続ける
If Mid(res_text, e_posi - 1, 1) <> "\" Then Exit Do
Loop While e_posi > 0
If e_posi > s_posi Then
content = Mid(res_text, s_posi, e_posi - s_posi)
content = Replace(content, "\n", vbNewLine)
content = Replace(content, "\""", """")
content = Replace(content, "\/", "/")
content = Replace(content, "\t", vbTab)
content = Replace(content, "\r", "")
Extract_Response = content
Else
Extract_Response = "レスポンスの解析に失敗しました。"
End If
Else
Extract_Response = "レスポンスにcontentが見つかりませんでした。"
End If
End Function
今まで作成した関数を組み合わせた、Execute_RAGプロシージャを作成します。 queryシートのセルB10以降に質問文を入力しておく想定です。
Execute_RAGプロシージャ
Public Sub Execute_RAG()
Dim fso As New Scripting.FileSystemObject
Dim req As New WinHttp.WinHttpRequest
Dim vector_data As Collection, top_docs As Collection
Dim query_embedding As Variant
Dim r As Range, c As Range
Dim query As String, context As String, answer As String, q_context As String, f_names As String
Const EMBEDDING_URL As String = "エンベッディングAPIのエンドポイント等の情報を指定します。"
Const CHAT_URL As String = "チャットAPIのエンドポイント等の情報を指定します。"
Const API_KEY As String = "APIキーを指定します。"
With ThisWorkbook.Sheets("query")
Set c = .Range(.Cells(10, 2), .Cells(.Cells(.Rows.count, 2).End(xlUp).Row, 2))
End With
Set vector_data = Load_Vector_Data()
If vector_data.count = 0 Then
MsgBox "ベクトルDBがロードされませんでした。終了します。"
Exit Sub
End If
For Each r In c
If Len(Trim(r.Value)) > 0 Then
query = r.Value
query_embedding = Get_Query_Embedding(query, EMBEDDING_URL, API_KEY) ' 類似度計算と上位文書取得
Set top_docs = Get_Top_SimilarDocs(query_embedding, vector_data, 3) ' 類似度計算と上位文書取得。上位は第3引数で指定
context = Build_Context(top_docs)
q_context = Split(context, "∬")(0)
f_names = Split(context, "∬")(1)
answer = Get_Chat_Response(query, q_context, CHAT_URL, API_KEY)
r.Offset(0, 1).Value = answer
r.Offset(0, 2).Value = f_names
End If
Next r
MsgBox "ナレッジ検索が完了しました。"
End Sub
以上ですべての準備が完了です。長くなりましたが、もうちょっとだけ続くんじゃ。
6. 使ってみる
queryシートに下表のように入力しておきます。queryは少なくしています。
ナレッジ検索のコマンドボタンに
Call Execute_RAG
としておきます。
ナレッジ検索のコマンドボタンを押すと以下のダイアログが出てくるので、保存しておいたベクトルDBのファイルを選択します。
しばらくするとナレッジ検索が完了しました。のメッセージが表示されますのでOKボタンを押して下さい。
queryへの回答と、関連するドキュメント（k=3）が返ってきています。
4℃様に関する質問にはいい感じに答えてくれていますし、4℃様以外の企業様に関する質問や全く関係ない質問には「分かりません」の回答が返ってきていますので、RAG構築はひとまず成功と言えるでしょう。
このようにエクセルVBAからAOAIのRAGを構築できたことで、また1つエクセルの凄みを分からされました。Execute_RAGプロシージャを関数化するとさらに柔軟な処理が可能になりますが、今回はこれまでとします。 今後AOAIのエンベッディングが社内で使えるようになった時に、プログラム資産や各種マニュアル、会議の議事録などの検索に大いに活用できそうです。
7. まとめ
エクセルVBAからAOAIのAPIでRAGを構築して、ナレッジ検索が簡単にできるようになりました。コードの解説が甘いところや不明な点は、それこそ生成AIに聞くと私より良い回答が返ってくるでしょうし、コードもリファインしてくれるに違いありません。
RAGの構築は本当に良い経験をさせて頂きました。データ前処理とプロンプトの大事さを改めて実感しました。
また、マイクロソフト様の最新技術であるAOAIと、同じくマイクロソフト様のトラディショナルなソフトウェアのエクセルを連携させる取り組みの中で、わずか一段ではありますが、私のスキルも向上したように感じています。
SIGNATE様、マイクロソフト様、ありがとうございました。
- コンペを振り返って
今回のコンペでは基本的にPythonで取り組んでおり、ラスト5日ぐらいからずっとやりたいと思っていたエクセル連携に着手しました。ちょうどその頃ぐらいから参加者の皆様のラストスパートが本当に良い刺激になりました。皆様お疲れ様でした。
またDataRobot様の生成AIのAPIを扱うのも楽しみにしていたんですが、リファレンス等を用意しただけで未着手に終わったことは猛省しています。
- 今後について
自社ではまだAPIでエンベッディングできるAOAIモデルは使えませんので所管部門におねだりしようと考えています。
プロキシ認証などを考慮する必要はあるものの、基本的にエンドポイント等を変えるだけで今回のコードがそのまま使用できるので、該当モデルがデプロイされ次第業務に活用できますし、Azure Cognitive Search等と組み合わせて精度向上も企画します。
また、エクセル大好きっ子を増やすべく、啓蒙と教育に社内外を問わず携わりたいです。