之前跟大家分享了，如何调用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
以上就是今天分享的全部内容，大家可以试一下~
