重汽修车群

今天跟全球共享下咱们若何自界说一个ExcelAI函数，匡助咱们搞定各式问题，操作也格外的浅陋，只需选择单位格，然后建议对应的条款即可，具体的效劳如下图所示。

图片重汽修车群

一、对于卡的问题

之前将过若何将Deepseek镶嵌的Excel表格，不少粉丝反馈太卡了，卡并不是代码卡，而是DeepSeek用的东说念主太多，API调用的相比慢，若是你嗅觉卡，不错从云服商那儿调取deepseek或者别的大模子，今天咱们便是在火山调用的豆包的大模子，速率也相比快了

图片

二、调用别的模子

咱们就以火山引擎为例，跟全球浅陋的演示下，泰国按摩群要津需要大要三个参数：KEY、模子的URL以及模子ID，这些在调用的时辰有教唆的，把柄操作来一步一步的操作即可，具体如下图所示

图片

三、更始代码

底下的代码我需要更始3处，具体操作如下所示，全球可获胜粘贴代码的时辰修改下

  Const API_KEY As String = "你的API"

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

BuildSafeInput = "{""model"":""模子的ID"",""messages""

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 FunctionErrorHandler:    ExcelAI = "Runtime Error: " & Err.DescriptionEnd 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 IfEnd 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 = strEnd 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 IfEnd Function

四、复制代码

掀开Excel点击【开辟用具】最左侧点击VB的裁剪窗口，然后在右侧点击窗口，找到【模块】插入模块后将代码获胜粘贴到右侧的空缺区域即可，一定需要牢记将上头的三处作念一下修改，工夫正确的调用到这个模子，至此就建造兑现了

用法：=ExcelAI(单位格,”你需要的收尾”)

图片

本站仅提供存储行状，扫数实质均由用户发布，如发现存害或侵权实质，请点击举报。

• 重汽修车群