我常用的 7 个 Excel VBA 小技巧：从一键开关到批量处理文件
摘要：用7个自写案例讲清VBA常用技巧：同步视图、属性开关、时间提示、友好时间、字体清单、数组排序、批量处理文件。
我平时写 Excel 宏，最怕一个小动作写成一大坨代码。其实很多 VBA 小技巧都不复杂，难点在于你得知道它能用在哪。
这篇我用 7 个自写场景来讲：月报视图同步、备注列一键换行、值班时间提醒、工单友好时间、字体清单导出、数组排序、批量导入文件。代码都可以直接改成你自己的表名、列名和文件名。
1. 同步所有可见工作表的视图：看月报少来回翻
我做月报时，经常有“华东、华南、华北”好几张结构一样的表。点到华东的 C18，再去华南时还得自己滚到 C18，这事很烦。
这个宏会记住三件事：当前工作表、当前选区、当前窗口滚动行列。它循环所有可见工作表，把每张表都对齐到同一块区域。隐藏表不处理，跑完再回到原来的表。
OptionExplicitSub AlignVisibleSheetsView()If TypeName(ActiveSheet) <> "Worksheet"ThenExitSubIf TypeName(Selection) <> "Range"ThenExitSubDim startSheet As WorksheetDim ws As WorksheetDim keepAddress AsStringDim keepTopRow AsLongDim keepLeftCol AsLongSet startSheet = ActiveSheet keepAddress = Selection.Address keepTopRow = ActiveWindow.ScrollRow keepLeftCol = ActiveWindow.ScrollColumn Application.ScreenUpdating = FalseForEach ws In ActiveWorkbook.WorksheetsIf ws.Visible = xlSheetVisible Then ws.ActivateOnErrorResumeNext ws.Range(keepAddress).Select ActiveWindow.ScrollRow = keepTopRow ActiveWindow.ScrollColumn = keepLeftColOnErrorGoTo0EndIfNext ws startSheet.Activate Application.ScreenUpdating = TrueEndSub
我觉得这里最值得记的是 Application.ScreenUpdating = False。它能减少屏幕闪烁，也能让宏看起来干净一点。另一个小细节是 TypeName(Selection) <> "Range"，它能挡掉图形、图表这类非单元格选区。
2. 用 Not 翻转布尔属性：备注列一键换行
VBA 里很多属性只有两个值：True 或 False。这类属性最适合用 Not 来切换。
比如客户反馈表里，备注列有时要展开，有时要压回一行。我会这么写：
Sub ToggleRemarkWrap()If TypeName(Selection) <> "Range"Then MsgBox "先选中要处理的单元格。", vbInformation, "VBA提示"ExitSubEndIf Selection.WrapText = Not ActiveCell.WrapText Selection.EntireRow.AutoFitEndSub
这里的参照点是 ActiveCell。如果选区里有的单元格已经换行，有的还没换行，宏会看当前活动单元格，再把整个选区切到相反状态。想让每个单元格各翻各的，就写 For Each cell In Selection 逐个处理。
同样的写法也能用在窗口显示上：
Sub ToggleGridAndHeadings()With ActiveWindow .DisplayGridlines = Not .DisplayGridlines .DisplayHeadings = Not .DisplayHeadingsEndWithEndSub
DisplayGridlines 控制网格线，DisplayHeadings 控制行号和列标。它们属于窗口显示设置，不是单元格格式。这个点挺重要，很多人会在工作表属性里找半天。
3. 日期、时间和个性化提示：开工前弹个值班提醒
Excel 保存日期和时间，本质上用的是序列值。你不需要每次都关心序列值长什么样，VBA 里用 Date、Time、Format 就能把它变成读得懂的文字。
我给运营同事写过一个值班提醒：打开工作簿后，弹出当天日期、当前时间，再按时间段换一句问候语。
Sub ShowDutyReminder()Dim dayText AsStringDim timeText AsStringDim hello AsStringDim fullName AsStringDim nickName AsStringDim spacePos AsLong dayText = Format(Date, "yyyy年m月d日") timeText = Format(Time, "hh:mm")SelectCase TimeCaseIs < TimeValue("12:00:00") hello = "早上好，"CaseIs >= TimeValue("18:00:00") hello = "晚上好，"CaseElse hello = "下午好，"EndSelect fullName = Application.UserName spacePos = InStr(1, fullName, " ")If spacePos > 1Then nickName = Left$(fullName, spacePos - 1)Else nickName = fullNameEndIf MsgBox dayText & vbCrLf & _"现在是 "&timeText&vbCrLf& _"今天记得看库存预警。", _ vbOKOnly+vbInformation,hello& nickNameEndSub
我会把这几个点记在一起：Date 取日期，Time 取时间，Format 管显示格式，TimeValue 让文字时间可以参与比较。Application.UserName 取 Excel 里的用户名，InStr 找空格，vbCrLf 负责换行，vbOKOnly 让消息框只显示一个“确定”。
想让日期跟随系统地区设置，可以写成：
Format(Date, "Long Date")Format(Time, "Medium Time")
想让所有电脑显示得一样，就写成固定格式，比如 yyyy年m月d日、hh:mm。
4. 友好时间：把“0.003472天”变成“5分钟前”
工单表里经常有“创建时间”和“当前时间”的差。直接显示天数太不友好，我会写一个自定义函数，让它显示成“刚刚、25分钟前、昨天、2周前”。
Function FriendlyGap(ByVal startAt As Variant, OptionalByVal endAt As Variant) As Variant Application.VolatileDim dayDiff AsDoubleDim seconds AsDoubleIfNot IsDate(startAt) Then FriendlyGap = CVErr(xlErrValue)ExitFunctionEndIfIf IsMissing(endAt) Then endAt = NowIfNot IsDate(endAt) Then FriendlyGap = CVErr(xlErrValue)ExitFunctionEndIf dayDiff = Abs(CDate(endAt) - CDate(startAt)) seconds = dayDiff * 24 * 60 * 60SelectCase secondsCaseIs < 30 FriendlyGap = "刚刚"CaseIs < 60 FriendlyGap=CLng(Int(seconds))& "秒前"CaseIs < 120 FriendlyGap = "1分钟前"CaseIs < 3600 FriendlyGap=CLng(Int(seconds/60))& "分钟前"CaseIs < 7200 FriendlyGap = "1小时前"CaseIs < 86400 FriendlyGap=CLng(Int(seconds/3600))& "小时前"CaseIs < 172800 FriendlyGap = "昨天"CaseIs < 604800 FriendlyGap=CLng(Int(dayDiff))& "天前"CaseIs < 2592000 FriendlyGap=CLng(Int(dayDiff/7))& "周前"CaseIs < 31536000 FriendlyGap=CLng(Int(dayDiff/30))& "个月前"CaseElse FriendlyGap=CLng(Int(dayDiff/365))& "年前"EndSelectEndFunction
在单元格里可以这样用：
我这里用 Abs，只看差了多久，不区分未来和过去。如果你要处理“3小时后到期”，可以去掉 Abs，再根据正负值拼“前”或“后”。
CVErr(xlErrValue) 也很有用。日期写坏了，函数直接给 #VALUE!，比悄悄算错更安全。
5. 导出字体清单：给公众号封面挑字体
Excel 没有一个很直接的方法告诉你“这台电脑装了哪些字体”。我会借一个老办法：临时创建工具栏，往里面加字体下拉控件，再从控件里读字体列表。
Sub ExportFontCatalog()Dim tempBar As CommandBarDim fontDrop As CommandBarControlDim ws As WorksheetDim i AsLongDim fontName AsStringOnErrorGoTo CleanUpSet tempBar = Application.CommandBars.Add( _ Name:="TmpFontList_" & Format(Now, "hhmmss"), _ Temporary:=True)Set fontDrop = tempBar.Controls.Add(ID:=1728, Temporary:=True)Set ws = Worksheets.Add ws.Name = "字体清单_" & Format(Now, "hhmmss") ws.Range("A1:C1").Value = Array("序号", "字体名", "标题预览")For i = 0To fontDrop.ListCount - 1 fontName = fontDrop.List(i + 1) ws.Cells(i + 2, 1).Value = i + 1 ws.Cells(i + 2, 2).Value = fontName ws.Cells(i + 2, 3).Value = "公众号标题预览" ws.Cells(i + 2, 3).Font.Name = fontNameNext i ws.Columns("A:C").AutoFitCleanUp:OnErrorResumeNextIfNot tempBar IsNothingThen tempBar.DeleteEndSub
ID:=1728 指向字体控件。读完后要删掉临时工具栏，这一步别省。
还有个小提醒：如果电脑里字体很多，给每一行都设置实际字体会吃资源。我试过，导出字体名很轻松，做全量预览时就明显更慢。你可以先注释掉这一行：
ws.Cells(i + 2, 3).Font.Name = fontName
6. 数组排序：别只会冒泡
Excel 工作表里有排序按钮，VBA 数组没有现成的排序函数。要处理数组排序，我一般按场景挑方法。
冒泡排序适合拿来讲概念：
Sub BubbleSortLong(ByRef nums() AsLong)Dim i AsLongDim j AsLongDim temp AsLongFor i = LBound(nums) To UBound(nums) - 1Forj=LBound(nums)ToUBound(nums)-1-(i- LBound(nums))Ifnums(j)>nums(j+1) Then temp= nums(j) nums(j)=nums(j+1) nums(j+1)= tempEndIfNext jNext iEndSub
普通数值数组，我更爱用快速排序：
Sub QuickSortLong(ByRef nums() AsLong, ByVal lo AsLong, ByVal hi AsLong)Dim i AsLongDim j AsLongDim pivot AsLongDim temp AsLong i = lo j = hi pivot = nums((lo + hi) \ 2)DoWhile i <= jDoWhile nums(i) < pivot i=i+ 1LoopDoWhile nums(j) > pivot j=j- 1LoopIf i <= j Then temp = nums(i) nums(i) = nums(j) nums(j) = temp i=i+ 1 j=j- 1EndIfLoopIf lo < j Then QuickSortLong nums, lo, jIf i < hi Then QuickSortLong nums, i, hiEndSub
调用时这样写：
QuickSortLong scores, LBound(scores), UBound(scores)
如果数组全是整数，并且取值范围不大，计数排序会很快：
Sub CountingSortLong(ByRef nums() AsLong, ByVal minVal AsLong, ByVal maxVal AsLong)Dim counts() AsLongDim i AsLongDim v AsLongDim p AsLongIf maxVal < minVal ThenExitSubReDim counts(minVal To maxVal)For i = LBound(nums) To UBound(nums)Ifnums(i)<minValOrnums(i)>maxVal Then Err.Raise 5, , "数组里有超出范围的值"EndIf counts(nums(i)) = counts(nums(i)) + 1Next i p = LBound(nums)For v = minVal To maxValDoWhile counts(v) > 0 nums(p) = v p=p+ 1 counts(v)=counts(v)- 1LoopNext vEndSub
也可以把数组丢到临时工作表，用 Excel 自带排序，再读回数组：
Sub SortByExcelSheet(ByRef nums() AsLong)Dim ws As WorksheetDim i AsLongDim n AsLong Application.ScreenUpdating = False Application.DisplayAlerts = FalseSet ws = ThisWorkbook.Worksheets.Add n = UBound(nums) - LBound(nums) + 1For i = LBound(nums) To UBound(nums) ws.Cells(i - LBound(nums) + 1, 1).Value = nums(i)Next i ws.Range("A1:A" & n).Sort _ Key1:=ws.Range("A1"), _ Order1:=xlAscending, _ Header:=xlNoFor i = LBound(nums) To UBound(nums) nums(i) = ws.Cells(i - LBound(nums) + 1, 1).ValueNext i ws.Delete Application.DisplayAlerts = True Application.ScreenUpdating = TrueEndSub
说白了，小数组随便写，大数组别硬上冒泡。快速排序和计数排序这两段我写成了 Long，如果你要排文字，就要换比较方式。这里涉及到一些算法相关的内容，后面会专门出一篇文章来讲解算法在编程工作中起到的作用。
7. 批量处理文件：把一批门店 CSV 合到汇总表
宏还有一个很常见的用途：重复处理一堆文件。比如一个文件夹里有杭州、深圳、成都的销售 CSV，我想把 sales_*.csv 都导入“流水汇总”工作表。
我习惯分两步写：先用 Dir 找文件，把文件名存进数组；再循环数组，逐个处理。这样写的好处是清楚，也能避开 Dir() 内部游标被别的代码打断。
Sub BatchImportStoreSales()Dim folder AsStringDim spec AsStringDim fileName AsStringDim todo() AsStringDim n AsLongDim i AsLong folder = ThisWorkbook.Path & "\store_files\" spec = folder & "sales_*.csv" fileName = Dir(spec)DoWhile Len(fileName) > 0 n = n + 1ReDimPreserve todo(1To n) todo(n) = folder & fileName fileName = Dir()LoopIf n = 0Then MsgBox "没有找到匹配文件：" & spec, vbInformationExitSubEndIfOnErrorGoTo SafeExit Application.ScreenUpdating = FalseFor i = 1To n ImportOneSalesFile todo(i)Next i Application.ScreenUpdating = True MsgBox "已导入 " & n & " 个门店文件。", vbInformationExitSubSafeExit: Application.ScreenUpdating = True MsgBox "处理时出错：" & Err.Description, vbExclamationEndSubSub ImportOneSalesFile(ByVal fullPath AsString)Dim src As WorkbookDim dst As WorksheetDim nextRow AsLongSet dst = ThisWorkbook.Worksheets("流水汇总") Workbooks.OpenText Filename:=fullPath, _ DataType:=xlDelimited, _ Comma:=True, _ Local:=TrueSet src = ActiveWorkbookWith src.Worksheets(1) nextRow = dst.Cells(dst.Rows.Count, "A").End(xlUp).Row + 1 .UsedRange.Copy dst.Cells(nextRow, "A")EndWith src.Close SaveChanges:=FalseWith dst .Range("H1").Value = "大单数量" .Range("I1").Value = "本批合计" .Range("H2").Formula = "=COUNTIF(E:E,"">=500"")" .Range("I2").Formula = "=SUM(E:E)"EndWithEndSub
Dir(spec) 第一次要带通配符，后面用 Dir() 继续取下一个文件。没有文件时要提前退出，别让后面的循环空跑。
如果导入的是固定宽度文本，可以把 OpenText 改成 DataType:=xlFixedWidth，再配 FieldInfo:=Array(...)。如果是 CSV，就像上面这样用 xlDelimited 和 Comma:=True。
我会怎么把这些技巧放进日常工作
我会把它们拆成几类：
这几个点看起来散，其实都围绕一件事：让 Excel 少做重复动作。你把其中一个场景跑通后，再换成自己的表名、列名、文件夹名，就能迁移到很多日常报表里。
