秒杀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

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