基于 Excel VBA 与大模型 API 实现用户反馈情感分析自动化

常见错误排查：

• 状态码 401：API Key 无效。请检查控制台重新复制密钥，确保无多余空格。
• 状态码 404：API 地址错误。请核对文档中的最新端点 URL 及模型 ID。
• 状态码 429：请求过于频繁。请增加请求间隔或升级配额。
• 状态码 0：网络连接问题。尝试切换网络环境（如关闭代理/VPN），或将 Excel 加入防火墙白名单。

2. 批量分析代码

连接测试通过后，可使用以下宏进行批量处理。该脚本会逐行读取评论，调用 API 并写入情感结果。

' 蓝耘 MaaS 情感分析 VBA 宏 (已通用化)
' 功能：批量分析 Excel 中的用户评论情感倾向
Sub BatchSentimentAnalysis()
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long
    Dim http As Object
    Dim comment As String, prompt As String
    Dim requestBody As String, resp As String
    Dim sentiment As String, note As String
    
    ' ================== 配置区域 ==================
    Const API_KEY As String = "YOUR_API_KEY"
    Const ENDPOINT_URL As String = "https://api.example.com/v1/chat/completions"
    Const INPUT_COL As String = "B"   ' 评论所在列
    Const OUTPUT_COL1 As String = "C" ' 情感结果列
    Const OUTPUT_COL2 As String = "D" ' 备注列
    Const START_ROW As Long = 2       ' 从第 2 行开始（第 1 行为标题）
    ' ===============================================
    
    ' 性能优化设置
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
    Set ws = ThisWorkbook.ActiveSheet
    lastRow = ws.Cells(ws.Rows.Count, INPUT_COL).End(xlUp).Row
    
    ' 数据验证
    If lastRow < START_ROW Then
        MsgBox "没有找到需要分析的评论数据。请检查 B 列是否有数据。", vbExclamation
        GoTo CleanExit
    End If
    
    ' 创建 HTTP 对象
    Set http = CreateObject("MSXML2.XMLHTTP")
    
    ' 主循环：逐行处理评论
    For i = START_ROW To lastRow
        comment = Trim(ws.Cells(i, ColumnLetterToNumber(INPUT_COL)).Value)
        
        ' 跳过空行
        If Len(comment) = 0 Then
            ws.Cells(i, ColumnLetterToNumber(OUTPUT_COL1)).Value = "无内容"
            ws.Cells(i, ColumnLetterToNumber(OUTPUT_COL2)).Value = ""
            GoTo ContinueNext
        End If
        
        ' 更新状态栏
        Application.StatusBar = "正在分析第 " & i - START_ROW + 1 & " / " & lastRow - START_ROW + 1 & " 条评论..."
        
        ' 构造分析请求
        prompt = "请判断下面这句话的情感倾向，只回答'积极'、'消极'或'中性'中的一个词，不要解释理由，不要加标点符号：" & vbCrLf & comment
        requestBody = "{\"model\": \"gpt-3.5-turbo\", " & _
                      "\"messages\": [" & _
                      "{\"role\": \"system\", \"content\": \"你是一个专业的情感分析助手，擅长分析用户评论的情感倾向。\"}, " & _
                      "{\"role\": \"user\", \"content\": \"" & EscapeJsonString(prompt) & "\"}" & _
                      "], " & _
                      "\"temperature\": 0.1, " & _
                      "\"max_tokens\": 10" & _
                      "}"
        
        ' 发送 API 请求
        With http
            .Open "POST", ENDPOINT_URL, False
            .setRequestHeader "Content-Type", "application/json"
            .setRequestHeader "Authorization", "Bearer " & API_KEY
            .send requestBody
        End With
        
        ' 处理响应
        If http.Status = 200 Then
            resp = http.responseText
            sentiment = ParseSentimentResponse(resp)
            note = "成功"
        Else
            sentiment = "请求失败"
            note = "错误 " & http.Status & ": " & GetHttpErrorMessage(http.Status)
        End If
        
        ' 写入结果
        ws.Cells(i, ColumnLetterToNumber(OUTPUT_COL1)).Value = sentiment
        ws.Cells(i, ColumnLetterToNumber(OUTPUT_COL2)).Value = note
        
        ' 每处理 10 条保存一次，防止数据丢失
        If (i - START_ROW) Mod 10 = 0 Then
            ThisWorkbook.Save
        End If
        
ContinueNext:
    Next i
    
    ' 最终保存
    ThisWorkbook.Save
    
    ' 完成提示
    Application.StatusBar = "分析完成！"
    MsgBox "情感分析完成！" & vbCrLf & _
           "共处理 " & lastRow - START_ROW + 1 & " 条评论。" & vbCrLf & _
           "结果已保存到 C 列（情感）和 D 列（状态）。", vbInformation
    
CleanExit:
    ' 恢复 Excel 设置
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.StatusBar = False
    
    ' 清理对象
    If Not http Is Nothing Then Set http = Nothing
End Sub

' 辅助函数：将列字母转换为列号
Function ColumnLetterToNumber(columnLetter As String) As Integer
    ColumnLetterToNumber = Range(columnLetter & "1").Column
End Function

' 辅助函数：转义 JSON 字符串中的特殊字符
Function EscapeJsonString(str As String) As String
    Dim result As String
    result = Replace(str, "\", "\\")
    result = Replace(result, "\"", "\"\"")
    result = Replace(result, vbCr, "\r")
    result = Replace(result, vbLf, "\n")
    result = Replace(result, vbTab, "\t")
    EscapeJsonString = result
End Function

' 辅助函数：解析 API 响应中的情感结果
Function ParseSentimentResponse(responseText As String) As String
    Dim sentiment As String
    ' 尝试从不同格式的响应中提取情感
    If InStr(responseText, "\"content\":\"\"") > 0 Then
        Dim contentStart As Integer
        contentStart = InStr(responseText, "\"content\":\"\"") + 11
        Dim contentEnd As Integer
        contentEnd = InStr(contentStart, responseText, "\"")
        If contentEnd > contentStart Then
            sentiment = Mid(responseText, contentStart, contentEnd - contentStart)
        End If
    ElseIf InStr(responseText, "积极") > 0 Then
        sentiment = "积极"
    ElseIf InStr(responseText, "消极") > 0 Then
        sentiment = "消极"
    ElseIf InStr(responseText, "中性") > 0 Then
        sentiment = "中性"
    Else
        sentiment = "解析失败"
    End If
    
    ' 清理结果
    sentiment = Trim(sentiment)
    sentiment = Replace(sentiment, "\"", "")
    sentiment = Replace(sentiment, ",", "")
    sentiment = Replace(sentiment, ".", "")
    sentiment = Replace(sentiment, "!", "")
    sentiment = Replace(sentiment, "?", "")
    ParseSentimentResponse = sentiment
End Function

' 辅助函数：获取 HTTP 错误消息
Function GetHttpErrorMessage(statusCode As Integer) As String
    Select Case statusCode
        Case 400: GetHttpErrorMessage = "请求格式错误"
        Case 401: GetHttpErrorMessage = "API 密钥无效"
        Case 403: GetHttpErrorMessage = "权限不足"
        Case 404: GetHttpErrorMessage = "API 端点不存在"
        Case 429: GetHttpErrorMessage = "请求过于频繁"
        Case 500: GetHttpErrorMessage = "服务器内部错误"
        Case 502: GetHttpErrorMessage = "网关错误"
        Case 503: GetHttpErrorMessage = "服务不可用"
        Case Else: GetHttpErrorMessage = "未知错误"
    End Select
End Function

注意： 请将代码中的 YOUR_API_KEY 和 ENDPOINT_URL 替换为您实际申请的凭证和接口地址。模型 ID 也请根据最新文档调整。

3. 运行分析与结果验证

在 Excel 界面，按 Alt + F8 跳出宏界面，选择 BatchSentimentAnalysis，点击【执行】。Excel 将逐步分析每一条评论的情感倾向。

处理完成后，C 列会显示情感标签（积极/消极/中性），D 列显示处理状态。若遇到报错，可参考上方的错误排查部分。

结果可视化：从数据到洞察

完成情感分类后，我们可以通过 Excel 自带的图表功能生成直观的分析报告。

情感分布饼图

选中 C 列（情感标签）数据，插入【饼图】，设置颜色（积极 - 绿色，消极 - 红色，中性 - 灰色），添加数据标签显示百分比。通过图表可快速发现产品满意度趋势，例如若消极占比过高，则说明产品质量或口碑存在问题，需及时改进。

方案优势与适用场景

1. 核心优势

• 效率提升：数千条数据人工分析需数天，本方案仅需几分钟，且客观一致。
• 成本可控：按实际调用量计费，远低于人力成本。
• 灵活扩展：支持调整模型参数、增加分析维度（如五级情感分类、槽位提取）。

2. 适用场景

• 电商行业：商品评价分析、竞品对比；
• 金融行业：客户投诉分类、风险预警；
• 教育行业：课程评价分析、教学改进；
• 政务领域：民意调查、政策反馈。

总结与展望

通过 Excel VBA 与大模型 API 的组合，我们将用户反馈情感分析的门槛从'专业数据团队'降低至'业务人员自助操作'。这种'低代码 + 大模型'的模式，不仅解决了传统分析的效率问题，更让企业能够快速从非结构化文本中提取业务洞察，实现'数据驱动决策'。未来，随着多模态大模型的发展，我们还可以扩展分析维度（比如结合图片/视频进行情感判断），进一步提升分析的深度与广度。对于希望快速落地 AI 应用的企业而言，这或许是最具性价比的切入点。