MK-Excel VBA编程与ChatGPT自动化实战-宏录制/条件判断-97java

Sub 销售报表美化()
'
' 销售报表美化 Macro
' 自动格式化销售数据
'

'
    Range("A1:E100").Select
    ActiveWorkbook.Worksheets("销售数据").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("销售数据").Sort.SortFields.Add2 Key:=Range( _
        "E2:E100"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("销售数据").Sort
        .SetRange Range("A1:E100")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A1:E100").AutoFilter Field:=5, Criteria1:=">10000"
    With Selection.Interior
        .Pattern = xlSolid
        .Color = 65535  ' 黄色背景
    End With
    With Selection.Borders
        .LineStyle = xlContinuous
        .Color = 0
        .Weight = xlThin
    End With
End Sub

Sub SmartSalesReportFormatting()
    ' 智能销售报表美化
    ' 支持动态数据范围，自动识别最后一行
    
    On Error GoTo ErrorHandler
    
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim dataRange As Range
    Dim sortRange As Range
    
    ' 设置工作表引用
    Set ws = ThisWorkbook.Worksheets("销售数据")
    
    ' 动态获取最后一行（避免硬编码）
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' 设置数据区域
    Set dataRange = ws.Range("A1:E" & lastRow)
    Set sortRange = ws.Range("A1:E" & lastRow)
    
    ' 关闭屏幕更新和自动计算（性能优化）
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    ' 1. 清除已有排序规则
    ws.Sort.SortFields.Clear
    
    ' 2. 按销售额降序排序（第5列）
    ws.Sort.SortFields.Add2 Key:=ws.Range("E2:E" & lastRow), _
        SortOn:=xlSortOnValues, _
        Order:=xlDescending, _
        DataOption:=xlSortNormal
    
    With ws.Sort
        .SetRange sortRange
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    ' 3. 筛选销售额大于10000（第5列）
    dataRange.AutoFilter Field:=5, Criteria1:=">10000"
    
    ' 4. 格式化可见单元格
    Dim visibleRange As Range
    On Error Resume Next
    Set visibleRange = dataRange.SpecialCells(xlCellTypeVisible)
    On Error GoTo ErrorHandler
    
    If Not visibleRange Is Nothing Then
        With visibleRange.Interior
            .Pattern = xlSolid
            .Color = RGB(255, 255, 0)  ' 黄色
        End With
        
        With visibleRange.Borders
            .LineStyle = xlContinuous
            .Color = RGB(0, 0, 0)
            .Weight = xlThin
        End With
    End If
    
    ' 5. 恢复设置
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
    ' 状态反馈
    MsgBox "报表美化完成！" & vbCrLf & _
           "数据行数：" & lastRow - 1 & vbCrLf & _
           "符合条件的记录数：" & visibleRange.Rows.Count - 1, _
           vbInformation, "完成"
    
    Exit Sub
    
ErrorHandler:
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    MsgBox "执行出错：" & Err.Description & vbCrLf & _
           "错误号：" & Err.Number, vbCritical, "错误"
End Sub

Function SalesRating(salesAmount As Double) As String
    ' 根据销售额返回评级
    
    Dim rating As String
    
    If salesAmount >= 100000 Then
        rating = "S级（卓越）"
    ElseIf salesAmount >= 50000 Then
        rating = "A级（优秀）"
    ElseIf salesAmount >= 20000 Then
        rating = "B级（良好）"
    ElseIf salesAmount >= 10000 Then
        rating = "C级（合格）"
    Else
        rating = "D级（待提升）"
    End If
    
    SalesRating = rating
End Function

' 批量评级子过程
Sub BatchRating()
    Dim lastRow As Long
    Dim i As Long
    Dim salesRange As Range
    
    lastRow = Cells(Rows.Count, "B").End(xlUp).Row  ' B列为销售额
    
    For i = 2 To lastRow
        Cells(i, "C").Value = SalesRating(Cells(i, "B").Value)
    Next i
    
    MsgBox "评级完成！共处理 " & lastRow - 1 & " 条记录"
End Sub

Function IdentifyHighRisk(clientData As Range) As Boolean
    ' 识别高风险客户
    ' clientData参数包含：销售额、回款率、账期天数
    
    Dim salesAmount As Double
    Dim paymentRate As Double
    Dim creditDays As Integer
    
    salesAmount = clientData.Cells(1, 1).Value
    paymentRate = clientData.Cells(1, 2).Value
    creditDays = clientData.Cells(1, 3).Value
    
    ' 风险条件：高销售额(>50万) AND (低回款率(<60%) OR 长账期(>90天))
    If salesAmount > 500000 And (paymentRate < 0.6 Or creditDays > 90) Then
        IdentifyHighRisk = True
    Else
        IdentifyHighRisk = False
    End If
End Function

' 批量风险标记
Sub MarkRiskyClients()
    Dim lastRow As Long
    Dim i As Long
    Dim riskResult As Boolean
    
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    For i = 2 To lastRow
        riskResult = IdentifyHighRisk(Range(Cells(i, "B"), Cells(i, "D")))
        If riskResult Then
            Cells(i, "E").Value = "高风险⚠️"
            Cells(i, "E").Interior.Color = RGB(255, 0, 0)  ' 红色底纹
            Cells(i, "E").Font.Bold = True
            Cells(i, "E").Font.Color = RGB(255, 255, 255)  ' 白色字体
        Else
            Cells(i, "E").Value = "正常"
        End If
    Next i
End Sub

Function GetSalaryMultiplier(level As String) As Double
    ' 根据岗位等级返回薪资倍数
    
    Select Case UCase(level)  ' 转大写统一比较
        Case "P1"
            GetSalaryMultiplier = 1.0
        Case "P2"
            GetSalaryMultiplier = 1.3
        Case "P3"
            GetSalaryMultiplier = 1.7
        Case "P4"
            GetSalaryMultiplier = 2.2
        Case "P5"
            GetSalaryMultiplier = 2.8
        Case "M1", "M2"  ' 管理层
            GetSalaryMultiplier = 3.5
        Case "EXEC"      ' 高管
            GetSalaryMultiplier = 5.0
        Case Else
            GetSalaryMultiplier = 1.0
            ' 记录未知等级
            Debug.Print "未知岗位等级: " & level
    End Select
End Function

【需求】销售数据日报自动生成
【数据源】"销售明细"工作表（A:F列），含：日期、销售员、产品、单价、数量、金额
【输出】"日报"工作表，按销售员汇总当日销售额、订单数、客单价
【触发条件】每日17:00自动运行
【格式要求】销售额降序排列，超过10万红色高亮

你是一位精通VBA的高级开发工程师。请根据以下需求生成完整的VBA代码：

[插入上述需求模板]

代码要求：
1. 包含清晰的注释说明
2. 使用错误处理（On Error）
3. 性能优化（关闭ScreenUpdating、Calculation）
4. 添加进度反馈（状态栏或进度条）
5. 生成后给出代码说明和使用指南

' =============================================
' 销售日报自动生成系统
' 版本: 2.0
' 作者: AI Assistant
' 日期: 2026-06-25
' 说明: 每日17:00自动生成销售日报
' =============================================

Option Explicit

Sub GenerateDailyReport()
    ' 主程序：生成销售日报
    
    Dim startTime As Double
    startTime = Timer
    
    ' 错误处理
    On Error GoTo ErrorHandler
    
    ' 性能优化
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.DisplayStatusBar = True
    
    ' 1. 变量声明
    Dim sourceWS As Worksheet
    Dim reportWS As Worksheet
    Dim lastRow As Long
    Dim dict As Object
    Dim key As Variant
    Dim i As Long
    Dim currentRow As Long
    
    ' 2. 设置工作表
    Set sourceWS = ThisWorkbook.Worksheets("销售明细")
    Set reportWS = ThisWorkbook.Worksheets("日报")
    
    ' 3. 清空日报表（保留标题）
    reportWS.Range("A2:D" & reportWS.Rows.Count).ClearContents
    reportWS.Range("A2:D" & reportWS.Rows.Count).Interior.ColorIndex = xlNone
    
    ' 4. 获取数据最后一行
    lastRow = sourceWS.Cells(sourceWS.Rows.Count, "B").End(xlUp).Row
    
    If lastRow < 2 Then
        MsgBox "没有数据可处理", vbExclamation
        GoTo Cleanup
    End If
    
    ' 5. 使用字典进行分组汇总
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' 状态栏更新
    Application.StatusBar = "正在处理数据，请稍候..."
    
    For i = 2 To lastRow
        Dim salesPerson As String
        Dim amount As Double
        Dim orderCount As Integer
        
        salesPerson = sourceWS.Cells(i, "B").Value
        amount = sourceWS.Cells(i, "F").Value
        orderCount = 1
        
        If Not dict.exists(salesPerson) Then
            ' 初始化字典条目（销售员、总金额、订单数、客单价占位）
            dict.Add salesPerson, Array(amount, orderCount, 0)
        Else
            ' 累加
            Dim tempArray As Variant
            tempArray = dict(salesPerson)
            tempArray(0) = tempArray(0) + amount
            tempArray(1) = tempArray(1) + orderCount
            dict(salesPerson) = tempArray
        End If
    Next i
    
    ' 6. 输出到日报表
    Application.StatusBar = "正在生成日报表格..."
    currentRow = 2
    
    For Each key In dict.keys
        Dim dataArray As Variant
        dataArray = dict(key)
        
        ' 计算客单价
        If dataArray(1) > 0 Then
            dataArray(2) = dataArray(0) / dataArray(1)
        Else
            dataArray(2) = 0
        End If
        
        ' 写入数据
        reportWS.Cells(currentRow, "A").Value = key
        reportWS.Cells(currentRow, "B").Value = dataArray(0)
        reportWS.Cells(currentRow, "C").Value = dataArray(1)
        reportWS.Cells(currentRow, "D").Value = Round(dataArray(2), 2)
        
        currentRow = currentRow + 1
    Next key
    
    ' 7. 格式化和条件高亮
    Dim lastReportRow As Long
    lastReportRow = currentRow - 1
    
    ' 排序（按销售额降序）
    With reportWS.Sort
        .SortFields.Clear
        .SortFields.Add2 Key:=reportWS.Range("B2:B" & lastReportRow), _
                         SortOn:=xlSortOnValues, _
                         Order:=xlDescending
        .SetRange reportWS.Range("A1:D" & lastReportRow)
        .Header = xlYes
        .Apply
    End With
    
    ' 条件高亮：销售额超过10万
    For i = 2 To lastReportRow
        If reportWS.Cells(i, "B").Value >= 100000 Then
            reportWS.Range("A" & i & ":D" & i).Interior.Color = RGB(255, 200, 200)
            reportWS.Range("A" & i & ":D" & i).Font.Bold = True
        End If
    Next i
    
    ' 添加合计行
    Dim totalRow As Long
    totalRow = lastReportRow + 2
    
    reportWS.Cells(totalRow, "A").Value = "合计"
    reportWS.Cells(totalRow, "B").Formula = "=SUM(B2:B" & lastReportRow & ")"
    reportWS.Cells(totalRow, "C").Formula = "=SUM(C2:C" & lastReportRow & ")"
    reportWS.Cells(totalRow, "D").Formula = "=B" & totalRow & "/C" & totalRow
    reportWS.Range("A" & totalRow & ":D" & totalRow).Font.Bold = True
    reportWS.Range("A" & totalRow & ":D" & totalRow).Interior.Color = RGB(200, 200, 255)
    
    ' 8. 自动调整列宽
    reportWS.Columns("A:D").AutoFit
    
Cleanup:
    ' 清理并恢复设置
    Set dict = Nothing
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.StatusBar = False
    
    ' 显示完成信息
    Dim elapsedTime As Double
    elapsedTime = Timer - startTime
    MsgBox "日报生成完成！" & vbCrLf & _
           "共统计 " & dict.Count & " 位销售员" & vbCrLf & _
           "用时 " & Format(elapsedTime, "0.00") & " 秒", _
           vbInformation, "成功"
    
    Exit Sub
    
ErrorHandler:
    ' 错误处理
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.StatusBar = False
    
    MsgBox "程序运行出错：" & vbCrLf & _
           "错误描述：" & Err.Description & vbCrLf & _
           "错误编号：" & Err.Number & vbCrLf & _
           "出错位置：第 " & Erl & " 行", _
           vbCritical, "错误"
End Sub

请解释以下VBA代码中每行的作用，并说明可以如何优化：

[粘贴代码]

这段VBA代码运行时出现"类型不匹配"错误（错误号13），
请分析可能的原因并给出修复方案。

[粘贴代码]

' 智能条件引擎：支持在Excel单元格中自定义条件
Function EvaluateCondition(conditionString As String, targetRange As Range) As Boolean
    ' 评估动态条件
    ' conditionString: 如 ">100" 或 ">=平均值*1.2"
    
    Dim evalResult As Variant
    Dim formulaString As String
    
    ' 构建评估公式
    formulaString = "=" & conditionString
    
    ' 使用Evaluate方法动态计算
    On Error Resume Next
    evalResult = Evaluate(formulaString)
    On Error GoTo 0
    
    If IsError(evalResult) Then
        EvaluateCondition = False
    Else
        EvaluateCondition = CBool(evalResult)
    End If
End Function

' 应用示例：动态筛选符合条件的数据
Sub DynamicFilter()
    Dim lastRow As Long
    Dim i As Long
    Dim condition As String
    Dim targetValue As Double
    
    ' 从配置表读取条件
    condition = ThisWorkbook.Worksheets("配置").Range("B2").Value
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    For i = 2 To lastRow
        targetValue = Cells(i, "B").Value
        
        ' 检查条件是否满足（使用Excel公式）
        If EvaluateCondition(condition & targetValue, Cells(i, "B")) Then
            Cells(i, "C").Value = "满足条件"
            Cells(i, "C").Interior.Color = RGB(144, 238, 144)  ' 浅绿
        Else
            Cells(i, "C").Value = "不满足"
            Cells(i, "C").Interior.Color = RGB(255, 182, 193)  ' 浅红
        End If
    Next i
End Sub

' 复杂的多级决策系统（客户等级判定）
Function DetermineCustomerGrade(customerData As Dictionary) As String
    ' 基于多维度数据的决策树
    
    Dim annualRevenue As Double
    Dim purchaseFrequency As Integer
    Dim returnRate As Double
    Dim creditScore As Integer
    Dim customerLifetime As Integer
    
    ' 提取数据
    annualRevenue = customerData("AnnualRevenue")
    purchaseFrequency = customerData("PurchaseFrequency")
    returnRate = customerData("ReturnRate")
    creditScore = customerData("CreditScore")
    customerLifetime = customerData("CustomerLifetime")
    
    ' 决策树逻辑
    ' 金牌客户：高营收 + 高频 + 低退货 + 高信用 + 长周期
    If annualRevenue > 1000000 And purchaseFrequency >= 12 And _
       returnRate < 0.05 And creditScore >= 750 And customerLifetime > 36 Then
        DetermineCustomerGrade = "白金"
        Exit Function
    End If
    
    ' 金牌客户：高营收 + 高频 + 低退货
    If annualRevenue > 500000 And purchaseFrequency >= 8 And returnRate < 0.1 Then
        DetermineCustomerGrade = "金牌"
        Exit Function
    End If
    
    ' 银牌客户：中等条件
    If annualRevenue > 200000 And purchaseFrequency >= 4 And returnRate < 0.15 Then
        DetermineCustomerGrade = "银牌"
        Exit Function
    End If
    
    ' 铜牌客户：基本条件
    If annualRevenue > 50000 And purchaseFrequency >= 2 Then
        DetermineCustomerGrade = "铜牌"
        Exit Function
    End If
    
    ' 普通客户
    DetermineCustomerGrade = "普通"
End Function

' 批量决策
Sub BatchCustomerGrading()
    Dim lastRow As Long
    Dim i As Long
    Dim customerData As Object
    Dim grade As String
    
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    For i = 2 To lastRow
        ' 构建客户数据字典
        Set customerData = CreateObject("Scripting.Dictionary")
        customerData.Add "AnnualRevenue", Cells(i, "B").Value
        customerData.Add "PurchaseFrequency", Cells(i, "C").Value
        customerData.Add "ReturnRate", Cells(i, "D").Value
        customerData.Add "CreditScore", Cells(i, "E").Value
        customerData.Add "CustomerLifetime", Cells(i, "F").Value
        
        ' 计算等级
        grade = DetermineCustomerGrade(customerData)
        Cells(i, "G").Value = grade
        
        ' 颜色标识
        Select Case grade
            Case "白金"
                Cells(i, "G").Interior.Color = RGB(192, 192, 192)  ' 银白
                Cells(i, "G").Font.Color = RGB(0, 0, 0)
            Case "金牌"
                Cells(i, "G").Interior.Color = RGB(255, 215, 0)    ' 金色
                Cells(i, "G").Font.Color = RGB(0, 0, 0)
            Case "银牌"
                Cells(i, "G").Interior.Color = RGB(192, 192, 192)  ' 银色
                Cells(i, "G").Font.Color = RGB(0, 0, 0)
            Case "铜牌"
                Cells(i, "G").Interior.Color = RGB(205, 127, 50)   ' 铜色
                Cells(i, "G").Font.Color = RGB(255, 255, 255)
            Case Else
                Cells(i, "G").Interior.Color = RGB(200, 200, 200)  ' 灰色
                Cells(i, "G").Font.Color = RGB(0, 0, 0)
        End Select
    Next i
    
    MsgBox "客户分级完成！共处理 " & lastRow - 1 & " 位客户"
End Sub

' 需要引用：Microsoft XML, v6.0
Function ChatGPTEvaluate(conditionDescription As String, customerData As String) As String
    ' 调用ChatGPT API进行智能评估
    
    Dim http As Object
    Dim apiKey As String
    Dim apiUrl As String
    Dim requestBody As String
    Dim response As String
    
    ' 配置（生产环境应从安全配置文件读取）
    apiKey = "YOUR_API_KEY"
    apiUrl = "https://api.openai.com/v1/chat/completions"
    
    ' 构建请求
    Set http = CreateObject("MSXML2.XMLHTTP")
    
    requestBody = "{""model"": ""gpt-3.5-turbo""," & _
                  """messages"": [" & _
                  "{""role"": ""system"", ""content"": ""你是一位客户评估专家，根据条件判断客户是否符合要求，只返回'是'或'否'""," & _
                  "{""role"": ""user"", ""content"": ""条件：" & conditionDescription & "\n客户数据：" & customerData & """}]}"
    
    ' 发送请求
    With http
        .Open "POST", apiUrl, False
        .setRequestHeader "Content-Type", "application/json"
        .setRequestHeader "Authorization", "Bearer " & apiKey
        .send requestBody
        
        If .Status = 200 Then
            response = .responseText
            ' 解析JSON响应（简化）
            If InStr(response, """是""") > 0 Or InStr(response, """Yes""") > 0 Then
                ChatGPTEvaluate = "是"
            Else
                ChatGPTEvaluate = "否"
            End If
        Else
            ChatGPTEvaluate = "API调用失败"
        End If
    End With
    
    Set http = Nothing
End Function

' 使用示例
Sub AICustomerEvaluation()
    Dim lastRow As Long
    Dim i As Long
    
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    For i = 2 To lastRow
        ' 构建客户数据摘要
        Dim customerSummary As String
        customerSummary = "年营收：" & Cells(i, "B").Value & _
                          "，购买频次：" & Cells(i, "C").Value & _
                          "，退货率：" & Cells(i, "D").Value & _
                          "，信用分：" & Cells(i, "E").Value & _
                          "，客户年限：" & Cells(i, "F").Value & "月"
        
        ' 调用AI评估（注意：生产环境应异步处理，避免阻塞）
        Dim result As String
        result = ChatGPTEvaluate( _
            "客户是否属于高价值群体？标准：年营收>50万或购买频次>8次/年且退货率<5%", _
            customerSummary _
        )
        
        Cells(i, "H").Value = result
    Next i
End Sub

' 在Ribbon中添加"AI助手"选项卡
' 需要先通过CustomUI Editor配置XML
' 以下是回调函数实现

Sub AICodeOptimizer(control As IRibbonControl)
    ' 优化选中的VBA代码
    
    Dim selectedCode As String
    Dim optimizedCode As String
    
    ' 获取当前选中的代码
    selectedCode = GetSelectedCode()
    
    If Len(selectedCode) = 0 Then
        MsgBox "请先选中需要优化的代码区域", vbExclamation
        Exit Sub
    End If
    
    ' 调用ChatGPT优化
    optimizedCode = CallChatGPTForCodeOptimization(selectedCode)
    
    ' 显示优化结果
    Dim resultForm As Object
    Set resultForm = CreateObject("UserForm")
    ' ... 显示代码对比界面
    
End Sub

Function GetSelectedCode() As String
    ' 从VBE中获取选中的代码
    Dim vbProj As VBIDE.VBProject
    Dim vbComp As VBIDE.VBComponent
    Dim codePane As VBIDE.CodePane
    
    Set vbProj = ThisWorkbook.VBProject
    Set vbComp = vbProj.ActiveVBProject.ActiveVBComponent
    Set codePane = vbComp.CodeModule.CodePane
    
    GetSelectedCode = codePane.GetSelection(1, 1, 1, 1)  ' 简化示例
End Function

' =============================================
' 【模板】VBA标准过程模板
' 说明: 包含完整的错误处理、性能优化、日志记录
' =============================================

Option Explicit

' 常量定义区
Private Const MODULE_NAME As String = "模块名"

' 公共变量区

' ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
' 过程名: MainProcess
' 功能: 主处理流程
' 参数: 无
' 返回: 无
' ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
Sub MainProcess()
    On Error GoTo ErrorHandler
    
    Dim startTime As Double
    startTime = Timer
    
    ' 1. 初始化
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
    ' 2. 核心逻辑
    ' ... 你的代码 ...
    
    ' 3. 日志记录
    LogMessage "MainProcess completed successfully"
    
Cleanup:
    ' 恢复设置
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    
    Debug.Print "Exec Time: " & Format(Timer - startTime, "0.00") & "s"
    Exit Sub
    
ErrorHandler:
    ' 错误记录
    Dim errMsg As String
    errMsg = "Error in " & MODULE_NAME & ".MainProcess" & vbCrLf & _
             "Number: " & Err.Number & vbCrLf & _
             "Description: " & Err.Description & vbCrLf & _
             "Line: " & Erl
    
    LogMessage errMsg, LogLevel.Error
    MsgBox errMsg, vbCritical, "程序错误"
    
    Resume Cleanup
End Sub

' 日志辅助函数
Enum LogLevel
    Info = 0
    Warning = 1
    Error = 2
End Enum

Sub LogMessage(message As String, Optional level As LogLevel = 0)
    ' 写入日志文件或工作表
    Dim logWS As Worksheet
    Dim lastRow As Long
    
    On Error Resume Next
    Set logWS = ThisWorkbook.Worksheets("日志")
    If logWS Is Nothing Then
        Set logWS = ThisWorkbook.Worksheets.Add
        logWS.Name = "日志"
        logWS.Range("A1:D1").Value = Array("时间", "级别", "模块", "消息")
    End If
    
    lastRow = logWS.Cells(logWS.Rows.Count, "A").End(xlUp).Row + 1
    
    logWS.Cells(lastRow, "A").Value = Now
    logWS.Cells(lastRow, "B").Value = level
    logWS.Cells(lastRow, "C").Value = MODULE_NAME
    logWS.Cells(lastRow, "D").Value = message
    
    ' 自动列宽
    logWS.Columns("A:D").AutoFit
End Sub

角色定义 + 任务描述 + 输入数据 + 输出格式 + 约束条件 + 示例