秒殺Deepseek，豆包跟Excel才是絕配，ExcelAI函數升級版來了！

之前跟大家分享了，如何調用Deepseek的API制作ExcelAI函數，但是不少粉絲都反饋體驗不好，主要還是反饋的結果太慢，數據量一大，就能不行了。

今天解決的方法來了，就是調用豆包的API，結果基本都是秒出，做到了跟常規函數幾乎一樣的速度，真的太爽了

一、找到豆包

想要調用豆包的API就需要通過火山引擎調用，這個就不再贅述了，之前都發過視頻了的，大家可以搜一下，注冊就是手機號注冊，然后實名認證就可以調用API了

來到首頁后，我們需要在右側點擊【模型廣場】有的找到【Doubao-1.5-lite-32k】然后點擊【查看詳情】

為什么要選擇【Doubao-1.5-lite-32k】這個模型呢，因為這個是輕量化的模型，主打低延遲，速度更快，我們使用ExcelAI函數的體驗也會更好

二、調用API

點擊【查看詳情】后會來到一個新的窗口，我們需要在當前的窗口中找到【推理】之后就會在右側看到一個窗口，如下截圖，我們獲取三處關鍵的數據

1.API KEY】這個需要自己創建下

2.【url它就是API】的地址，已經在下圖標注，記得全部復制

3.【Model】它就是模型的ID

獲取上方的三個關鍵數據后，就能做API的調用了

三、更改代碼

當前的代碼我們需要修改3處，也正好對應我們上一步獲取的三處，大家記得一定要全部替換下才能正確調用API，修改后使用這個AI函數了，下面是它的參數

=ExcelAI(需要處理的單元格,”你的需求”)

1.【你的API替換為】豆包的API KEY

2.【模型的URL地址】替換為豆包的url

3.【模型的ID】替換為豆包的模型ID

Function ExcelAI(TargetCell As Range, Question As String) As Variant

On Error GoTo ErrorHandler

Const API_KEY As String ="你的API" ' 需替換有效密鑰

Const API_URL As String ="模型的URL地址"

' 構建安全請求

Dim safeInput As String

safeInput = BuildSafeInput(TargetCell.Text, Question)

' 發送API請求

Dim response As String

response = PostRequest(API_KEY, API_URL, safeInput)

' 解析響應內容

If Left(response, 5) ="Error"Then

ExcelAI = response

Else

ExcelAI = ParseContent(response)

End If

Exit Function

ErrorHandler:

ExcelAI ="Runtime Error: "& Err.Description

End Function

' 構建安全輸入內容

Private Function BuildSafeInput(Context As String, Question As String) As String

Dim sysMsg As String

If Len(Context) > 0 Then

sysMsg ="{""role"":""system"",""content"":""上下文："& EscapeJSON(Context) &"""},"

End If

BuildSafeInput ="{""model"":""模型的ID"",""messages"":["& _

sysMsg &"{""role"":""user"",""content"":"""& EscapeJSON(Question) &"""}]}"

End Function

' 發送POST請求

Private Function PostRequest(apiKey As String, url As String, payload As String) As String

Dim http As Object

Set http = CreateObject("MSXML2.XMLHTTP")

On Error Resume Next

With http

.Open"POST", url, False

.setRequestHeader"Content-Type","application/json"

.setRequestHeader"Authorization","Bearer "& apiKey

.send payload

If Err.Number <> 0 Then

PostRequest ="Error: HTTP Request Failed"

Exit Function

End If

' 增加10秒超時控制

Dim startTime As Double

startTime = Timer

Do While .readyState < 4 And Timer - startTime < 10

DoEvents

Loop

End With

If http.Status = 200 Then

PostRequest = http.responseText

Else

PostRequest ="Error "& http.Status &": "& http.statusText

End If

End Function

' JSON特殊字符轉義

Private Function EscapeJSON(str As String) As String

str = Replace(str,"\", "\\")

str = Replace(str, """", "\""")

str = Replace(str, vbCr, "\r")

str = Replace(str, vbLf, "\n")

str = Replace(str, vbTab, "\t")

EscapeJSON = str

End Function

' 智能解析響應內容

Private Function ParseContent(json As String) As String

Dim regex As Object, matches As Object

Set regex = CreateObject("VBScript.RegExp")

' 增強版正則表達式

With regex

.Pattern = """content"":\s*""((?:\\""|[\s\S])*?)"""

.Global = False

.MultiLine = True

.IgnoreCase = True

End With

Set matches = regex.Execute(json)

If matches.Count > 0 Then

Dim rawText As String

rawText = matches(0).SubMatches(0)

' 反轉義處理

rawText = Replace(rawText, "\""", """")

rawText = Replace(rawText, "\\", "\")

rawText = Replace(rawText, "\n", vbCrLf)

rawText = Replace(rawText, "\r", vbCr)

rawText = Replace(rawText, "\t", vbTab)

ParseContent = rawText

Else

' 錯誤信息提取

Dim errMatch As Object

regex.Pattern = """message"":\s*""(.*?)"""

Set errMatch = regex.Execute(json)

If errMatch.Count > 0 Then

ParseContent = "API Error:" & errMatch(0).SubMatches(0)

Else

ParseContent = "Invalid Response"

End If

End If

End Function

以上就是今天分享的全部內容，大家可以試一下~