批量改名超费时？VBA给Excel加改名神器
一句话核心价值点：让零基础职场人用不到30行的VBA代码，把烦人的批量改名活儿变成一键完成，效率飙升还不用死磕语法。
目录
文件堆里翻名字？秒搜定位
办公室常遇到：下载或导出的文件一大堆，名字像乱码，想找某个客户的资料得一个个瞄。用眼睛筛费时又易漏，函数和透视表只能处理表格里的数据，管不了电脑里的文件名。
Sub 快速定位文件() Dim fso As Object, folder As Object, file As Object Dim kw As String, path As String, msg As String Set fso = CreateObject("Scripting.FileSystemObject") path = "C:\Users\Public\Documents\2026项目\" '改成你的文件夹 kw = InputBox("输入关键字（如客户名）：", "搜索文件名") If kw = "" Then Exit Sub Set folder = fso.GetFolder(path) msg = "" For Each file In folder.Files If InStr(1, file.Name, kw, vbTextCompare) > 0 Then msg = msg & file.Name & vbCrLf End If Next If msg = "" Then MsgBox "没找到匹配项" Else MsgBox "匹配文件：" & vbCrLf & msgEnd Sub
原理很简单：用VBA调用文件系统对象，把指定文件夹里的文件名扫一遍，发现含关键字的就列出来。函数和透视表碰不到硬盘文件，这种跨软件抓信息只有VBA能直接干。
手动改到眼花？批量替字快
做报表要把“2025版”统一换成“2026版”，几十个文件名手动改不仅慢，还容易手滑改错。公式只能在单元格里换文字，改不了文件名。
Sub 批量替换文件名() Dim fso As Object, folder As Object, file As Object Dim oldT As String, newT As String, path As String Set fso = CreateObject("Scripting.FileSystemObject") path = "C:\Users\Public\Documents\2026项目\" oldT = InputBox("要替换的文字：", "旧文本") newT = InputBox("替换成：", "新文本") If oldT = "" Or newT = "" Then Exit Sub Set folder = fso.GetFolder(path) For Each file In folder.Files If InStr(file.Name, oldT) > 0 Then file.Name = Replace(file.Name, oldT, newT) End If Next MsgBox "替换完成！"End Sub
VBA直接动系统层面的文件名，像在资源管理器里改名一样快，而且一次过遍历所有文件，不怕漏掉。公式只能改单元格，没法碰真实文件，这就是VBA的专属地盘。
序号老对不齐？自动补位稳
导出文件常带序号，比如“报告1.xlsx”“报告10.xlsx”，排序会乱成“1、10、2”。手动补零很磨人，函数和透视表管不到文件名结构。
Sub 序号自动补位() Dim fso As Object, folder As Object, file As Object Dim path As String, m As Object, n As Long, baseLen As Long Set fso = CreateObject("Scripting.FileSystemObject") path = "C:\Users\Public\Documents\2026项目\" baseLen = InputBox("序号位数（如3则001）：", "补位长度", 3) If Not IsNumeric(baseLen) Then Exit Sub baseLen = CLng(baseLen) Set folder = fso.GetFolder(path) Set m = CreateObject("Scripting.Dictionary") For Each file In folder.Files If file.Name Like "报告*.*" Then n = Val(Mid(file.Name, 3, Len(file.Name))) If n > 0 Then m(n) = file.Name End If Next Dim k As Variant For Each k In m.Keys Dim newName As String newName = "报告" & Format(k, String(baseLen, "0")) & "." & fso.GetExtensionName(m(k)) fso.GetFile(path & m(k)).Name = newName Next MsgBox "补位完成！"End Sub
这里先用字典收集序号和文件名，再用Format按指定位数补零，最后一次性改名。手工改要盯着每一位数字，VBA帮你算好排整齐，效率和美观兼得。
多表重名难分？加前缀区分
同一批文件来自不同部门，名字都是“月度统计.xlsx”，合并或查找时容易覆盖。函数改不了外部文件名，透视表更管不到。
Sub 加前缀区分文件() Dim fso As Object, folder As Object, file As Object Dim path As String, dept As String Set fso = CreateObject("Scripting.FileSystemObject") path = "C:\Users\Public\Documents\2026项目\" dept = InputBox("输入部门前缀（如销售_）：", "加前缀") If dept = "" Then Exit Sub Set folder = fso.GetFolder(path) For Each file In folder.Files If Left(file.Name, Len(dept)) <> dept Then file.Name = dept & file.Name End If Next MsgBox "前缀添加完成！"End Sub
VBA直接读文件名并拼接前缀，不改内容只改标识，让来源一目了然。这种批量标记动作，只有能操控文件系统的VBA才办得到。
条件改名太绕？规则随心定
有时改名要看内容，比如文件名含“紧急”就加“❗”，含“完成”就加“✅”。函数和透视表只能分析表里数据，碰不到文件名逻辑。
Sub 条件智能改名() Dim fso As Object, folder As Object, file As Object Dim path As String Set fso = CreateObject("Scripting.FileSystemObject") path = "C:\Users\Public\Documents\2026项目\" Set folder = fso.GetFolder(path) For Each file In folder.Files Dim nm As String: nm = file.Name If InStr(nm, "紧急") > 0 And Left(nm, 1) <> "❗" Then file.Name = "❗" & nm ElseIf InStr(nm, "完成") > 0 And Right(nm, 1) <> "✅" Then file.Name = nm & "✅" End If Next MsgBox "条件改名完成！"End Sub
规则写在代码里，可随需要增删，像设了个小机器人守在文件夹，见关键词就贴标签。表格工具搞不定这种动态判断与系统级改动。
跨文件夹改名？一次扫全清
文件散在多个子文件夹，手动逐个进目录改名累到怀疑人生。函数和透视表只能盯当前工作簿，跨层级访问非VBA莫属。
Sub 跨文件夹批量改名() Dim fso As Object, folder As Object, subF As Object, file As Object Dim path As String, oldT As String, newT As String Set fso = CreateObject("Scripting.FileSystemObject") path = "C:\Users\Public\Documents\2026项目\" oldT = InputBox("要替换的文字：", "旧文本") newT = InputBox("替换成：", "新文本") If oldT = "" Or newT = "" Then Exit Sub Set folder = fso.GetFolder(path) Call RenameInFolder(folder, oldT, newT) MsgBox "跨文件夹替换完成！"End SubSub RenameInFolder(f As Object, oldT As String, newT As String) Dim file As Object, sf As Object For Each file In f.Files If InStr(file.Name, oldT) > 0 Then file.Name = Replace(file.Name, oldT, newT) End If Next For Each sf In f.SubFolders Call RenameInFolder(sf, oldT, newT) NextEnd Sub
递归遍历所有子文件夹，不管几层都能一次改完。这是VBA调用系统对象的深度玩法，表格工具根本够不着。
金句收尾：
公式是表里的巧手，VBA是系统的遥控器。重复的事交给代码，省下的时间陪家人笑。学一点VBA，就像给办公桌装了自动档。
别把时间耗在机械点击上，用十几行代码让电脑替你跑腿，你会发现2026年的办公可以很轻盈。
更多干货点我头像进主页，每天更新
