是50条实用的VBA代码示例，涵盖Excel常用场景

以下是50条实用的VBA代码示例，涵盖Excel常用场景（文本形式输出）：

1. 批量合并单元格内容

`Range("A1").Value = Join(Application.Transpose(Range("A1:A10")), ",")`

将A1:A10内容合并到A1单元格并用逗号分隔

2. 自动删除空行

`Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete`

删除第一列为空的所有行

3. 快速创建目录页

`For Each ws In Worksheets: Hyperlinks.Add Anchor:=Cells(n,1), Address:="", SubAddress:=ws.Name & "!A1": Next`

为所有工作表生成带超链接的目录

4. 多条件筛选导出

`AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("Criteria"), CopyToRange:=Range("Output")`

根据指定条件区域筛选数据

5. 跨表数据汇总

`Consolidate Sources:=Array("Sheet1!R1C1:R10C2","Sheet2!R1C1:R8C2"), Function:=xlSum`

合并多个工作表相同区域数据

6. 智能填充序列

`Selection.DataSeries Rowcol:=xlColumns, Type:=xlChronological, Date:=xlDay`

生成智能日期序列（考虑工作日）

7. 动态条件格式

`Range("A1:A100").FormatConditions.Add Type:=xlExpression, Formula1:="=A1>AVERAGE(A:A)"`

标记超过平均值的单元格

8. 批量重命名工作表

`Sheets(i).Name = "Data_" & Format(i, "00")`

将工作表按Data_01格式编号

9. 快速生成数据透视表

`ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=Range("A1:E100")).CreatePivotTable TableDestination:="Sheet2!R3C1"`

自动化创建透视表

10. 邮件合并功能

`Application.MailEnvelope.Item.To = Range("B" & i).Value`

自动填充Outlook邮件收件人

11. 批量插入图片

`ActiveSheet.Shapes.AddPicture Filename:="C:\Pic.jpg", LinkToFile:=False, SaveWithDocument:=True, Left:=Cells(i,2).Left, Top:=Cells(i,2).Top, Width:=100, Height:=100`

将图片按单元格位置插入

12. 自动生成图表

`Charts.Add.SetSourceData Source:=Sheets("Data").Range("A1:D10")`

根据数据区域创建图表

13. 密码保护工作表

`ActiveSheet.Protect Password:="1234", AllowFormattingCells:=True`

设置带密码的工作表保护

14. 快速清除内容

`Range("A1:Z100").ClearContents`

清空指定区域数据保留格式

15. 批量导出PDF

`ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Report.pdf"`

将当前表导出为PDF

16. 数据分列处理

`Range("A1:A100").TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, Other:=True, OtherChar:="/"`

按"/"符号分割文本到多列

17. 自动调整列宽

`Cells.EntireColumn.AutoFit`

根据内容自动调整所有列宽

18. 高亮重复值

`Range("A1:A100").FormatConditions.AddUniqueValues DupeUnique:=xlDuplicate`

标记重复数据

19. 创建下拉列表

`With Range("B2").Validation.Add Type:=xlValidateList, Formula1:="苹果,香蕉,橘子"`

设置单元格下拉菜单

20. 批量替换内容

`Cells.Replace What:="旧文本", Replacement:="新文本", LookAt:=xlPart`

全表范围替换文本

21. 合并多工作簿

`Workbooks.Open Filename:="C:\Data.xlsx": Sheets().Move After:=ThisWorkbook.Sheets(Sheets.Count)`

合并其他工作簿的表

22. 自动添加批注

`Range("A1").AddComment Text:="数据来源：财务部"`

为单元格添加说明批注

23. 数据有效性验证

`Range("C1:C100").Validation.Add Type:=xlValidateWholeNumber, Minimum:=1, Maximum:=100`

限制输入1-100整数

24. 快速排序数据

`Range("A1:D100").Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlYes`

按B列升序排序

25. 自动添加超链接

`ActiveSheet.Hyperlinks.Add Anchor:=Range("A1"), Address:="https://www.example.com"`

创建网页链接

26. 提取单元格公式

`Debug.Print Range("A1").Formula`

在立即窗口显示公式

27. 批量隐藏行

`Rows("5:10").Hidden = True`

隐藏指定行

28. 创建自定义函数

`Function Tax(salary): Tax = salary * 0.1: End Function`

创建计算个税的函数

29. 定时保存文档

`Application.OnTime Now + TimeValue("01:00:00"), "SaveWorkbook"`

每小时自动保存

30. 生成随机数据

`Range("A1") = WorksheetFunction.RandBetween(1,100)`

生成1-100随机数

31. 批量重命名文件

`Name "C:\old.txt" As "C:\new.txt"`

修改文件名

32. 快速跳转单元格

`Application.Goto Reference:=Range("A100"), Scroll:=True`

滚动到指定单元格

33. 数据加密存储

`Range("A1").Value = StrConv("文本", vbUnicode)`

将文本转为Unicode编码

34. 自动生成目录结构

`MkDir "C:\Reports\" & Format(Date, "yyyy-mm")`

按日期创建文件夹

35. 网页数据抓取

`With ActiveSheet.QueryTables.Add(Connection:="URL;http://example.com", Destination:=Range("A1"))`

导入网页表格数据

36. 语音朗读数据

`Application.Speech.Speak Range("A1").Value`

朗读单元格内容

37. 自定义快捷键

`Application.OnKey "^+T", "MacroName"`

设置Ctrl+Shift+T快捷键

38. 自动生成二维码

`ActiveSheet.OLEObjects.Add(ClassType:="BARCODE.BarcodeCtrl.1").Object.Value = Range("A1").Value`

需安装MS Barcode控件

39. 批量打印区域

`ActiveSheet.PageSetup.PrintArea = "$A$1:$G$50"`

设置固定打印区域

40. 颜色计数统计

`WorksheetFunction.CountIf(Range("A1:A100"), ColorIndex:=3)`

统计红色单元格数量

41. 自动发送邮件

`OutlookApp.CreateItem(0).Send`

需引用Outlook对象库

42. 数据模糊匹配

`WorksheetFunction.VLookup(Range("A1"), Range("B:C"), 2, True)`

近似匹配查询

43. 生成数据签名

`ActiveSheet.Signatures.Add.Sign`

添加数字签名

44. 拆分工作表

`Sheets.Add After:=Sheets(Sheets.Count): Range("A1:D100").Copy Destination:=Sheets(2).Range("A1")`

按条件拆分到新表

45. 自动生成SQL语句

`"INSERT INTO Table VALUES('" & Range("A1") & "','" & Range("B1") & "')"`

构建SQL插入语句

46. 数据转置处理

`Range("A1:A10").Copy: Range("B1").PasteSpecial Transpose:=True`

行列转置粘贴

47. 自动生成日历

`ActiveSheet.Calendar.Year = 2023`

需安装日历控件

48. 读写注册表

`SaveSetting "MyApp", "Startup", "LastDate", Date`

存储程序运行记录

49. 内存优化

`Erase myArray: Set myObject = Nothing`

释放对象和数组内存

50. 错误处理模板

`On Error GoTo ErrorHandler: ... Exit Sub: ErrorHandler: MsgBox Err.Description`

标准错误处理结构

（注意：部分代码需调整引用或启用权限，建议在测试环境先验证）