还在为Excel重复操作熬夜？手把手教你用 DeepSeek 生成VBA代码！每个案例附 提问话术+完整代码+效果说明，打工人的摸鱼秘籍来啦~

案例1：多表合并一键聚合

痛点场景

每月要手动合并20+部门报表，Ctrl+C按到手指抽筋！

提问DeepSeek

"用VBA合并工作簿中所有工作表的数据到‘总表’，跳过空行且保留表头"

DeepSeek生成代码

Sub MergeAllSheets()  
    Dim ws As Worksheet  
    Application.ScreenUpdating = False  
    Sheets("总表").Cells.ClearContents  
    For Each ws In ThisWorkbook.Worksheets  
        If ws.Name <> "总表" Then  
            ws.UsedRange.Offset(1).Copy _  
            Destination:=Sheets("总表").Range("A" & Rows.Count).End(xlUp).Offset(1)  
        End If  
    Next ws  
    Application.ScreenUpdating = True  
    MsgBox "已合并 " & Worksheets.Count - 1 & " 个分表数据！"  
End Sub

效果亮点

• 自动跳过总表本身
• 合并后弹窗提示汇总数量
• 关闭屏幕刷新提升运行速度

案例2：智能标红异常值

痛点场景

每天要检查1000+条订单，金额超标肉眼难发现

提问DeepSeek

"写宏：当C列数值超过5000时整行标黄，并在D列标注‘超标’"

DeepSeek生成代码

Sub MarkAbnormalData()  
    Dim rng As Range  
    For Each rng In Range("C2:C" & Cells(Rows.Count, "C").End(xlUp).Row)  
        If rng.Value > 5000 Then  
            rng.EntireRow.Interior.Color = RGB(255, 255, 0)  
            rng.Offset(0, 1).Value = "超标"  
        End If  
    Next  
    Columns("D:D").AutoFit  
    MsgBox "已完成异常数据标记！"  
End Sub

效果亮点

• 自动调整D列宽度
• 超标数据双重提醒（颜色+文字）
• 支持RGB自定义颜色

案例3：秒级去重+统计

痛点场景

客户名单3000条，重复数据导致群发邮件被退

提问DeepSeek

"用VBA删除A列重复值，保留第一个并显示删除了多少条"

DeepSeek生成代码

Sub SmartRemoveDuplicates()  
    Dim originalCount As Long  
    originalCount = Application.CountA(Range("A:A"))  
    Range("A:A").RemoveDuplicates Columns:=1, Header:=xlYes  
    MsgBox "原始数据：" & originalCount & " 条" & vbNewLine & _  
           "现保留：" & Application.CountA(Range("A:A")) & " 条" & vbNewLine & _  
           "已删除：" & originalCount - Application.CountA(Range("A:A")) & " 条重复项"  
End Sub

效果亮点

• 动态统计删除数量
• 弹窗显示完整对比数据
• 自动识别表头

案例4：批量导出PDF

痛点场景

要给50个客户单独生成对账单

提问DeepSeek

"写宏：将每个客户的Sheet导出为PDF，按A1单元格内容命名"

DeepSeek生成代码

Sub ExportSheetsToPDF()  
    Dim ws As Worksheet  
    Dim savePath As String  
    savePath = ThisWorkbook.Path & "\客户对账单\"  
    If Dir(savePath, vbDirectory) = "" Then MkDir savePath  
    For Each ws In Worksheets  
        If ws.Name <> "总表" Then  
            ws.ExportAsFixedFormat _  
                Type:=xlTypePDF, _  
                Filename:=savePath & ws.Range("A1").Value & ".pdf", _  
                Quality:=xlQualityStandard  
        End If  
    Next  
    MsgBox "已生成 " & Worksheets.Count - 1 & " 份PDF到：" & vbNewLine & savePath  
End Sub

效果亮点

• 自动创建存储文件夹
• 按指定单元格命名文件
• 跳过总表避免误操作

案例5：智能填充公式

痛点场景

每天要给空白单元格补VLOOKUP公式

提问DeepSeek

"写宏：在D列空白单元格自动填入VLOOKUP公式，查找E列对应值"

DeepSeek生成代码

Sub AutoFillFormula()  
    Dim lastRow As Long  
    lastRow = Cells(Rows.Count, "D").End(xlUp).Row  
    For i = 2 To lastRow  
        If Cells(i, "D").Value = "" Then  
            Cells(i, "D").Formula = "=VLOOKUP(E" & i & ",$A$2:$B$1000,2,FALSE)"  
        End If  
    Next  
    Range("D:D").Copy  
    Range("D:D").PasteSpecial xlPasteValues  
    MsgBox "已完成公式智能填充！"  
End Sub

效果亮点

• 跳过非空单元格提升效率
• 粘贴为值防止公式错乱
• 绝对引用确保查找范围固定

案例6：自动邮件周报

痛点场景

每周五都要手动发数据给老板

提问DeepSeek

"用VBA每周五16点自动发送A1:G20区域数据到boss@company.com"

DeepSeek生成代码

Sub AutoSendEmail()  
    Dim OutlookApp As Object  
    Set OutlookApp = CreateObject("Outlook.Application")  
    Dim MailItem As Object  
    Set MailItem = OutlookApp.CreateItem(0)  
    ThisWorkbook.Sheets("周报").Range("A1:G20").Copy  
    With MailItem  
        .To = "boss@company.com"  
        .Subject = Format(Now, "yyyy-mm-dd") & " 周报数据"  
        .Body = "老板您好，本周数据已自动生成，请查收附件。"  
        .Attachments.Add ThisWorkbook.FullName  
        .Display  ' 发送前预览（测试时可改为.Send直接发送）  
    End With  
    MsgBox "邮件已准备就绪！"  
End Sub

效果亮点

• 自动附加当前工作簿
• 邮件标题带日期戳
• 支持直接发送或人工确认

文末福利 | 代码使用指南

1. 快捷键设置：开发工具→宏→选择宏→选项→设置Ctrl+字母
2. 代码调试：按F8逐行运行，鼠标悬停查看变量值
3. 错误处理：在代码开头加 On Error Resume Next 跳过简单报错

互动话题

你们最想自动化哪些Excel操作？评论区许愿，下期继续肝！
下期剧透：《DeepSeek玩转Word：自动生成合同/报告的神操作！》
点击关注，解锁更多办公神器！