AI+VBA:6个真实案例让你的Excel自动飞起来

AI+VBA：6个真实案例让你的Excel自动飞起来

不用学编程基础，AI帮你写VBA代码，直接复制粘贴就能用

图1：每周五下午，面对堆积如山的Excel文件，你的内心是不是这样的？

周五下午5点47分，老板在群里甩来一句："把30个分公司的月度报表汇总一下，下班前给我。"你打开文件夹，30个Excel文件，每个格式还不统一——有的日期列是文本，有的金额带单位，有的表头多了一行空行。

你的第一反应是什么？手动复制粘贴？一个文件一个文件打开，复制，切回汇总表，粘贴，调整格式，处理异常……两小时后，你还在搞第8个文件。而隔壁小王，已经用VBA+AI，3分钟全部搞定，提前去吃火锅了。

这不是段子，这是每天都在真实发生的职场场景。VBA是Excel最强大的自动化武器，而AI让这把武器人人都能拿起——你不需要会编程，只需要会"提需求"。

01 / 为什么VBA依然不可或缺

2024年，Python在办公自动化领域风头正劲，很多人问："VBA是不是该淘汰了？"答案恰恰相反。VBA不仅没有过时，反而在AI的加持下焕发了第二春。

原因很简单：VBA内嵌在Excel里，零安装、零配置。Python需要装环境、装库、配路径，而VBA的运行环境就是Excel本身。你把写好的宏发给同事，他Alt+F11粘贴一下就能用，不需要安装任何东西。

VBA vs Python vs 手动操作 对比

图2：AI+VBA黄金搭档的工作流程

更重要的是，AI彻底消除了VBA的学习门槛。以前你学VBA，要搞懂变量、循环、条件判断、对象模型……现在你只需要用大白话把需求告诉AI，它就能直接生成可用的代码。你甚至不需要理解每一行代码的意思，只要能跑就行。

接下来，我通过6个真实职场场景，手把手带你体验"AI写VBA"的全过程。每个案例都有完整代码，直接复制粘贴就能用。

02 / 案例一：批量重命名工作表

场景描述

财务部的张姐，每个月从ERP系统导出数据，Excel文件里有50多个工作表，名字全是"Sheet1""Sheet2""Sheet3"……她需要把每个工作表按A1单元格的内容重命名，方便后续查找。

以前张姐的做法是：双击Sheet标签，看一眼A1的内容，输入名字，回车，下一个……50个Sheet，至少花15分钟，还容易输错。

AI生成的VBA代码

对AI说："帮我写一个VBA宏，遍历当前工作簿中所有工作表，将每个工作表的名字改为该表A1单元格的值，如果A1为空则跳过。"

SubBatchRenameSheets()     Dim ws As Worksheet     Dim newName AsStringDim count AsLong     count = 0' 遍历所有工作表For Each ws In ThisWorkbook.Worksheets         ' 取A1单元格的值作为新名称         newName = Trim(ws.Range("A1").Value)          ' 如果不为空，且名称合法，则重命名If newName <> ""ThenOn Error Resume Next             ws.Name = newName             If Err.Number = 0Then                 count = count + 1End IfOn Error GoTo0End IfNext ws      MsgBox "重命名完成！共处理 " & count & " 个工作表"End Sub

效果说明：运行后，所有A1单元格有内容的工作表都会被自动重命名，空白的跳过，重名的会忽略。50个Sheet，1秒钟搞定，还会弹窗告诉你处理了多少个。

03 / 案例二：自动合并多文件数据

场景描述

销售部的小李，每周要汇总20多个区域经理提交的销售数据。每个经理发来一个Excel文件，格式一样——都是A到F列，第一行是表头。小李需要把这20多个文件的数据合并到一张表里。

手动做法：逐个打开文件，全选复制，切回汇总表找最后一个空行粘贴，关闭文件……20个文件至少40分钟。中间一旦出错，还得重新来。

图3：多文件数据合并自动化示意

AI生成的VBA代码

对AI说："帮我写VBA，把指定文件夹下所有Excel文件的数据合并到当前工作表，第一行作为表头只保留一次，跳过隐藏文件和当前文件本身。"

SubMergeAllFiles()     Dim folderPath AsStringDim fileName AsStringDim wb As Workbook     Dim ws As Worksheet     Dim targetRow AsLongDim lastRow AsLongDim fileCount AsLongDim totalRows AsLong' 选择文件夹With Application.FileDialog(msoFileDialogFolderPicker)         .Title = "请选择要合并的Excel文件所在文件夹"If .Show = -1Then             folderPath = .SelectedItems(1) & "\\"Else             MsgBox "未选择文件夹，操作取消"Exit SubEnd IfEnd With' 清空当前表（保留表头）Set ws = ThisWorkbook.Sheets(1)     ws.Rows("2:" & ws.Rows.count).ClearContents     targetRow = 2     fileCount = 0     totalRows = 0      Application.ScreenUpdating = False     Application.DisplayAlerts = False' 遍历文件夹中的Excel文件     fileName = Dir(folderPath & "*.xls*")     Do While fileName <> ""' 跳过当前文件本身If fileName <> ThisWorkbook.Name ThenSet wb = Workbooks.Open(folderPath & fileName, ReadOnly:=True)             Set sourceWs = wb.Sheets(1)              ' 找到源数据的最后一行             lastRow = sourceWs.Cells(sourceWs.Rows.count, "A").End(xlUp).Row              ' 复制数据（跳过第一行表头）If lastRow >= 2Then                 sourceWs.Range("A2:F" & lastRow).Copy _                     ws.Range("A" & targetRow)                 totalRows = totalRows + (lastRow - 1)                 targetRow = ws.Cells(ws.Rows.count, "A").End(xlUp).Row + 1                 fileCount = fileCount + 1End If              wb.Close FalseEnd If         fileName = Dir()     Loop      Application.ScreenUpdating = True     Application.DisplayAlerts = True      MsgBox "合并完成！" & vbCrLf & _            "文件数：" & fileCount & vbCrLf & _            "数据行数：" & totalRows End Sub

效果说明：运行后会弹出文件夹选择窗口，选中存放Excel的文件夹，代码自动逐个打开、复制数据、关闭文件。表头只保留第一份，数据全部追加到当前工作表。20个文件，10秒内完成。

04 / 案例三：一键生成日报

场景描述

运营部的王同学，每天要写日报：从业务系统导出当日数据，统计订单量、销售额、新增用户数、退款金额等指标，填到日报模板里，再格式化一下。

这套流程每天重复，但每天的数据不同。关键痛点是：数据源格式每天变，统计公式容易引用错行。一旦公式引用错误，日报数据就是错的，被领导发现就尴尬了。

图4：自动生成日报，数据统计一秒完成

AI生成的VBA代码

对AI说："写一个VBA宏，从当前工作簿的'原始数据'Sheet中，统计订单量（COUNTA）、总销售额（SUM）、新增用户数（COUNTIF状态为新注册）、退款金额（SUMIF类型为退款），将结果填入'日报'Sheet的对应单元格，并设置日期为今天。"

SubGenerateDailyReport()     Dim dataSheet As Worksheet     Dim reportSheet As Worksheet     Dim lastRow AsLong' 设置工作表引用On Error Resume NextSet dataSheet = ThisWorkbook.Sheets("原始数据")     Set reportSheet = ThisWorkbook.Sheets("日报")     On Error GoTo0If dataSheet Is Nothing Or reportSheet Is Nothing Then         MsgBox "请确保工作簿中包含'原始数据'和'日报'两个工作表"Exit SubEnd If' 找到数据最后一行     lastRow = dataSheet.Cells(dataSheet.Rows.count, "A").End(xlUp).Row      ' 填入日期     reportSheet.Range("B1").Value = Date     reportSheet.Range("B1").NumberFormat = "yyyy-mm-dd"' 统计订单量（A列为订单号）     reportSheet.Range("B2").Value = _         WorksheetFunction.CountA(dataSheet.Range("A2:A" & lastRow))      ' 统计总销售额（D列为金额）     reportSheet.Range("B3").Value = _         WorksheetFunction.Sum(dataSheet.Range("D2:D" & lastRow))     reportSheet.Range("B3").NumberFormat = "#,##0.00"' 统计新增用户数（E列为状态）     reportSheet.Range("B4").Value = _         WorksheetFunction.CountIf(dataSheet.Range("E2:E" & lastRow), "新注册")      ' 统计退款金额（C列为类型，D列为金额）     reportSheet.Range("B5").Value = _         WorksheetFunction.SumIf(dataSheet.Range("C2:C" & lastRow), _         "退款", dataSheet.Range("D2:D" & lastRow))     reportSheet.Range("B5").NumberFormat = "#,##0.00"' 格式化日报表     reportSheet.Range("A1:B5").Borders.LineStyle = xlContinuous     reportSheet.Columns("A:B").AutoFit      MsgBox "日报生成完成！日期：" & Format(Date, "yyyy年mm月dd日") End Sub

效果说明：一键运行后，"日报"Sheet自动填入当天日期、订单总量、销售额、新增用户、退款金额，数字自动格式化为千分位，表格自动加边框。原来每天花20分钟的日报，现在1秒完成。

05 / 案例四：数据清洗与去重

场景描述

人事部的赵经理，手里有一份3000多行的员工花名册，从不同系统导出合并而来。问题来了：同一批人可能重复录入了好几次，有些手机号前后有空格，有些日期格式不统一（"2024/1/5"和"2024-01-05"混用），有些姓名是全角空格。

如果用Excel自带的"删除重复项"功能，只能按整行匹配，无法按身份证号或手机号智能去重。赵经理之前用条件格式逐行标记，人工核对，搞了一整天。

图5：数据清洗前后对比——乱数据变整齐

AI生成的VBA代码

对AI说："写VBA代码清洗数据：1）去除所有单元格前后空格和全角空格 2）统一日期格式为yyyy-mm-dd 3）按C列（身份证号）去重，保留第一次出现的行，删除后续重复行，并标记被删除的行数。"

SubCleanAndDeduplicate()     Dim ws As Worksheet     Dim lastRow AsLongDim i AsLongDim cell As Range     Dim dict As Object     Dim dupCount AsLongSet ws = ActiveSheet     lastRow = ws.Cells(ws.Rows.count, "A").End(xlUp).Row     Set dict = CreateObject("Scripting.Dictionary")      Application.ScreenUpdating = False' 第一步：清洗——去除空格For Each cell In ws.Range("A2:Z" & lastRow)         If VarType(cell.Value) = vbString Then             cell.Value = Replace(Trim(cell.Value), _                 Chr(12288), "")  ' 去除全角空格End IfNext cell      ' 第二步：统一日期格式For Each cell In ws.Range("B2:B" & lastRow)         If IsDate(cell.Value) Then             cell.Value = CDate(cell.Value)             cell.NumberFormat = "yyyy-mm-dd"End IfNext cell      ' 第三步：按C列（身份证号）去重     dupCount = 0For i = lastRow To2 Step -1Dim idValue AsString         idValue = Trim(CStr(ws.Cells(i, 3).Value))          If idValue <> ""ThenIf dict.Exists(idValue) Then                 ws.Rows(i).Delete                 dupCount = dupCount + 1Else                 dict.Add idValue, 1End IfEnd IfNext i      Application.ScreenUpdating = True      MsgBox "清洗完成！" & vbCrLf & _            "删除重复行：" & dupCount & " 行" & vbCrLf & _            "剩余数据：" & (ws.Cells(ws.Rows.count, "A").End(xlUp).Row - 1) & " 行"End Sub

效果说明：代码分三步执行——先清洗所有文本单元格的空格（含全角空格），再统一日期格式，最后按身份证号字典去重（从下往上删，避免索引错位）。3000行数据清洗去重，3秒内完成，精确告诉你删了多少重复行。

06 / 案例五：自动发送邮件报表

场景描述

每个周一早上，区域经理老陈都要给8个下属分别发送上周的个人业绩报表。每封邮件的收件人不同，附件不同，正文里的数据也不一样。

老陈的操作流程：打开Outlook，新建邮件，输入收件人，选附件，写正文，发送；再新建第二封……8封邮件，至少25分钟。偶尔还会发错附件，把张三的报表发给了李四，场面一度十分尴尬。

图6：VBA自动化邮件——一键批量发送，精准到人

AI生成的VBA代码

对AI说："写VBA通过Outlook批量发邮件。收件人信息、附件路径、个性化数据在'邮件清单'Sheet中，A列收件人邮箱，B列姓名，C列附件路径，D列上周销售额。邮件标题统一为'上周业绩报表-姓名'，正文包含姓名和对应销售额。"

SubBatchSendEmails()     Dim OutlookApp As Object     Dim OutlookMail As Object     Dim ws As Worksheet     Dim lastRow AsLongDim i AsLongDim emailTo AsStringDim empName AsStringDim filePath AsStringDim sales AsStringDim sendCount AsLongSet ws = ThisWorkbook.Sheets("邮件清单")     lastRow = ws.Cells(ws.Rows.count, "A").End(xlUp).Row      ' 创建Outlook对象Set OutlookApp = CreateObject("Outlook.Application")     sendCount = 0      Application.ScreenUpdating = False' 遍历邮件清单For i = 2To lastRow         emailTo = Trim(ws.Cells(i, 1).Value)         empName = Trim(ws.Cells(i, 2).Value)         filePath = Trim(ws.Cells(i, 3).Value)         sales = Trim(ws.Cells(i, 4).Value)          If emailTo <> ""ThenSet OutlookMail = OutlookApp.CreateItem(0)              With OutlookMail                 .To = emailTo                 .Subject = "上周业绩报表 - " & empName                 .Body = empName & "，你好：" & vbCrLf & vbCrLf & _                     "  上周个人销售额：" & sales & " 元" & vbCrLf & vbCrLf & _                     "  详细报表见附件，请查阅。" & vbCrLf & vbCrLf & _                     "  此邮件由系统自动发送。"' 如果附件路径存在则添加If filePath <> ""And Dir(filePath) <> ""Then                     .Attachments.Add filePath                 End If                  .Send  ' 如需先预览改为 .DisplayEnd With              sendCount = sendCount + 1End IfNext i      Application.ScreenUpdating = True' 清理对象Set OutlookMail = NothingSet OutlookApp = Nothing      MsgBox "邮件发送完成！共发送 " & sendCount & " 封"End Sub

效果说明：代码调用Outlook自动创建邮件，按"邮件清单"Sheet逐行读取收件人、姓名、附件、数据，自动填入邮件模板并发送。8封个性化邮件，5秒全部发出，零失误。建议首次运行时把.Send改为.Display先预览确认。

07 / 案例六：智能数据对比与高亮差异

场景描述

审计部的刘工，每月要做系统数据与财务数据对账。两份表的结构相同——都有订单号、客户名、金额、日期四列，但数据量都在5000行以上，靠肉眼逐行对比根本不现实。

刘工的需求很明确：找出两份表之间的差异——哪些行在A表有但B表没有？哪些行的金额不一致？找到差异后高亮标记，方便后续核实。

AI生成的VBA代码

对AI说："写VBA对比两个Sheet的数据差异。Sheet名分别为'系统数据'和'财务数据'，按A列（订单号）匹配，找出：1）仅在系统数据中存在的行（黄色标记）2）仅在财务数据中存在的行（蓝色标记）3）订单号相同但金额不一致的行（红色标记），金额列是C列。将差异汇总到'差异报告'Sheet。"

SubCompareDataSheets()     Dim wsSys As Worksheet, wsFin As Worksheet     Dim wsReport As Worksheet     Dim dictSys As Object, dictFin As Object     Dim lastRowSys AsLong, lastRowFin AsLongDim i AsLong, reportRow AsLongDim key AsStringDim onlySys AsLong, onlyFin AsLong, amtDiff AsLong' 设置工作表Set wsSys = ThisWorkbook.Sheets("系统数据")     Set wsFin = ThisWorkbook.Sheets("财务数据")      ' 创建差异报告表     Application.DisplayAlerts = FalseOn Error Resume Next     ThisWorkbook.Sheets("差异报告").Delete     On Error GoTo0     Application.DisplayAlerts = TrueSet wsReport = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.count))     wsReport.Name = "差异报告"' 设置报告表头     wsReport.Range("A1:D1").Value = Array("订单号", "差异类型", "系统金额", "财务金额")     wsReport.Range("A1:D1").Font.Bold = TrueSet dictSys = CreateObject("Scripting.Dictionary")     Set dictFin = CreateObject("Scripting.Dictionary")      lastRowSys = wsSys.Cells(wsSys.Rows.count, "A").End(xlUp).Row     lastRowFin = wsFin.Cells(wsFin.Rows.count, "A").End(xlUp).Row      ' 加载系统数据到字典For i = 2To lastRowSys         key = Trim(CStr(wsSys.Cells(i, 1).Value))         If key <> ""Then             dictSys(key) = wsSys.Cells(i, 3).Value  ' C列金额End IfNext i      ' 加载财务数据到字典For i = 2To lastRowFin         key = Trim(CStr(wsFin.Cells(i, 1).Value))         If key <> ""Then             dictFin(key) = wsFin.Cells(i, 3).Value         End IfNext i      reportRow = 2     onlySys = 0: onlyFin = 0: amtDiff = 0' 对比：仅在系统数据中存在For Each key In dictSys.Keys         If Not dictFin.Exists(key) Then             wsReport.Cells(reportRow, 1).Value = key             wsReport.Cells(reportRow, 2).Value = "仅在系统数据"             wsReport.Cells(reportRow, 3).Value = dictSys(key)             wsReport.Cells(reportRow, 2).Interior.Color = RGB(255, 255, 0)  ' 黄色             onlySys = onlySys + 1             reportRow = reportRow + 1End IfNext key      ' 对比：仅在财务数据中存在For Each key In dictFin.Keys         If Not dictSys.Exists(key) Then             wsReport.Cells(reportRow, 1).Value = key             wsReport.Cells(reportRow, 2).Value = "仅在财务数据"             wsReport.Cells(reportRow, 4).Value = dictFin(key)             wsReport.Cells(reportRow, 2).Interior.Color = RGB(0, 176, 240)  ' 蓝色             onlyFin = onlyFin + 1             reportRow = reportRow + 1End IfNext key      ' 对比：订单号相同但金额不一致For Each key In dictSys.Keys         If dictFin.Exists(key) ThenIf dictSys(key) <> dictFin(key) Then                 wsReport.Cells(reportRow, 1).Value = key                 wsReport.Cells(reportRow, 2).Value = "金额不一致"                 wsReport.Cells(reportRow, 3).Value = dictSys(key)                 wsReport.Cells(reportRow, 4).Value = dictFin(key)                 wsReport.Cells(reportRow, 2).Interior.Color = RGB(255, 0, 0)  ' 红色                 amtDiff = amtDiff + 1                 reportRow = reportRow + 1End IfEnd IfNext key      wsReport.Columns("A:D").AutoFit      MsgBox "对比完成！" & vbCrLf & _            "仅系统数据：" & onlySys & " 条" & vbCrLf & _            "仅财务数据：" & onlyFin & " 条" & vbCrLf & _            "金额不一致：" & amtDiff & " 条" & vbCrLf & _            "差异报告已生成到'差异报告'Sheet"End Sub

效果说明：使用字典对象实现O(n)时间复杂度的高效对比，5000行数据的两表对比2秒完成。差异自动生成到"差异报告"Sheet，三色标记一目了然：黄色=仅系统有、蓝色=仅财务有、红色=金额不一致，附具体金额方便核对。

08 / AI+VBA黄金搭档总结与行动指南

6个案例回顾

AI+VBA的正确打开方式

通过上面6个案例，我们可以总结出AI+VBA的黄金工作流，一共就4步：

Step 1：描述需求用大白话把你的需求说清楚——要对什么数据做什么操作，输入是什么、输出是什么。越具体，AI给的代码越准确。

Step 2：粘贴代码把AI生成的代码复制，在Excel里按 Alt+F11 打开VBA编辑器，插入模块，粘贴代码。

Step 3：运行测试按F5运行，检查结果。如果报错，直接把报错信息发给AI，让它修改。

Step 4：保存复用把文件另存为 .xlsm 格式，代码永久保存在文件里，下次直接用。

记住一个关键原则：你不需要理解每一行代码。AI就是你的程序员，你只需要当好"产品经理"——把需求描述清楚。代码报错了？把错误信息丢给AI，它会帮你调试。需要加功能？告诉AI"再加一个xxx功能"，它会修改代码。

写在最后

VBA不会消亡，它只是换了一种被使用的方式——以前需要3个月学习的编程技能，现在AI帮你3分钟搞定。6个案例，6段代码，覆盖了职场中最常见的Excel自动化场景。今天就开始试一下，从最简单的"批量重命名Sheet"开始，把代码复制到你的Excel里跑一跑，你会打开一个全新的效率世界。

你的工作中，哪个Excel操作最让你头疼？

评论区告诉我，下篇文章可能就帮你写好对应的VBA代码

* 本文所有VBA代码均在Excel 2016及以上版本测试通过，.xlsm格式保存后可永久复用