入坑开始的前因后果：
前不久，由于内人工作上的需要，开始接触并研究 Excel VBA 的使用。
一张表格里有几十家甚至上百家业务往来单位，要按照对应的单位名称生成单独的一张对账单表格。如果只是机械地复制粘贴来处理，不仅工作效率低，而且非常浪费时间，严重影响其他工作的开展。
于是在网上搜索教程时，看到一个视频是通过 VBA 来批量生成对账单，于是便开始入坑研究起来。
从零接触到零基础，边解读代码边学习基础知识，渐渐熟悉每一行代码的含义和可以实现的功能，然后根据实际工作需求调试原视频的代码，并自行编写满足需求的代码。经过无数次调试失败、修改代码，最终实现了通过 VBA 一键批量生成对账单。
需要实现的功能
通过 VBA 可以一键批量生成对账单，并另存为以单位名称命名的独立对账单。
下图是需要生成对账单的磅单明细表格，为保护隐私数据已做相应处理。
下图是模板表格，按照此表格格式自动生成对应的对账单。
运行程序后，生成对账单的效果如下：
部分代码解读（完整代码附后）
操作软件：Microsoft Office Excel 2021
使用功能：Visual Basic
- 主程序开始执行前的预处理
屏幕刷新（ScreenUpdating），值为 False 时关闭，作用是使 Excel 停止刷新，提高代码执行速度。
Application.ScreenUpdating = False显示警报（DisplayAlerts），值为 False 时关闭，作用是屏蔽弹窗提示。
Application.DisplayAlerts = False- 声明与定义
声明工作表对象： dqsh 表示当前工作表，fzmb 表示复制模板，mb 表示模板，sxrg 表示筛选。
声明工作簿对象： wb
%： 表示短整型
声明字典对象： d
定义存储区域的数组： arr, arr1
记录代码运行的起始时间： t
Dim dqsh As Worksheet, fzmb As Worksheet, mb As Worksheet, sxrg As Range
Dim wb As Workbook, y%, r%, x%, k%, i%, d
Dim arr, arr1
t = TimerCreateObject 函数创建字典对象，可将以下代码作为固定代码使用。
Set d = CreateObject("scripting.dictionary")把当前工作簿的活动工作表交给 dqsh，把模板工作表赋值给 mb。
Set dqsh = ThisWorkbook.ActiveSheet
Set mb = Sheets("模板")- 对“磅单明细”工作表进行取消筛选操作
防止后面定位产生偏差。
dqsh.AutoFilterMode = False- 定位最后一行，获取总行数
r = dqsh.Range("L65536").End(xlUp).Row拓展知识：
要定位到数据最后一行时，有以下几种情况：
方法 1：
MsgBox "A列最后一个非空单元格行号为：" & Range("a1").End(xlDown).Row从上往下寻找连续数据区域的边缘。如果数据中间存在空格，该方法寻找的行号不准确。一般不建议使用此方法，因为行数较多时，无法保证中间不会存在空行。
为避免上述问题，可使用以下方法。
方法 2：
MsgBox "A列最后一个非空单元格行号为：" & Range("a1048576").End(xlUp).Row从下往上寻找，可避免数据中间存在空格的情况。
但由于 Excel 版本问题，最后一行的行号不一定是 1048576，因此有另一种写法，也是最常用的写法。
MsgBox "A列最后一个非空单元格行号为：" & Cells(Rows.Count, 1).End(xlUp).Row- 将 L 列的客户信息存放到 arr 数组里
UBound 函数用来返回指定数组维度的最大下标。
利用字典去重复值，一个客户名称只保留一个唯一值。
L 表示磅单明细里的第 L 列，后面需要对客户列（L 列）进行筛选操作。实际工作中可能会有变化，根据具体情况调整。
arr = dqsh.Range("L3:L" & r)
For x = 1 To UBound(arr)
d(arr(x, 1)) = " "
Next x运行该 Responsible for handling sensitive data, please ensure all operations comply with privacy regulations. 段代码后的情况如下：
把字典 d 中的客户名称转置后放到新数组 arr1 里。
arr1 = Application.Transpose(d.keys)运行后结果如下：
- 利用 for 循环开始对客户进行筛选操作
For k = 1 To UBound(arr1)arr1 数组里存储的值为：
arr1(1,1) = “A有限公司”
arr1(2,1) = “B有限公司”
arr1(3,1) = “C有限公司”
对应的 UBound 函数返回的值为：1、2、3
当 k=1 时，开始对 A 有限公司进行筛选操作。
dqsh.Range("L2").AutoFilter 12, arr1(k, 1)自动筛选（AutoFilter）：Range.AutoFilter 方法
AutoFilter 12 自动筛选第 12 列（磅单明细中客户所在的列数为 12），arr1(k, 1) 为筛选条件。
此时 k=1，arr1(1, 1) 对应的值为 A 有限公司，因此开始对 A 有限公司进行筛选操作。
执行后如下图：
筛选操作完成后，利用 SpecialCells 方法定位 L 列可见单元格的数量，然后赋值给变量 i。
i = dqsh.Range("L3:L" & r).SpecialCells(xlCellTypeVisible).Cells.Count运行后，本地窗口中 i 的值为 6，即 A 有限公司共有 6 行数据。
- 复制模板工作表
然后把复制的模板交给变量 fzmb。
mb.Copy after:=Sheets(Sheets.Count)
Set fzmb = ActiveSheet
设置复制后的工作表名称：
fzmb.Name = arr1(k, 1)用数组 arr1(k, 1) 对应的值命名复制后的工作表。
接下来需要在复制后的模板里进行插入行的操作。模板里没有空白行，如何让系统自动判断并插入合适的行数？
这里用到筛选操作时用到的变量 i，它保存的值是 A 有限公司所有的行数。
A 有限公司的行数决定了需要插入的行数。
fzmb.Range("a4").Resize(i).EntireRow.Insert此时 i=6，就插入 6 行。
- 插入行后，复制粘贴筛选出的 A 有限公司信息
磅单明细工作表中把 A2 单元格所在的连续区域交给变量 sxrg。
Set sxrg = dqsh.Range("A2").CurrentRegionCurrentRegion 表示单元格的当前区域。
sxrg.Offset(2, 0).Resize(sxrg.Rows.Count - 2).Copy fzmb.Range("A4")Offset(2, 0)： 表示向下偏移 2 行。
变量 sxrg 存放的连续区域包含第一、二行，而前两行数据不需要，因此做向下偏移处理。
如图：
向下偏移后，需在原有基础上减去后面 2 行空白行：Rows.Count – 2
然后将处理好的数据复制粘贴到模板的 A4 单元格。
如图：
再将 J 列之后的数据全部删除。
- 动态求和公式
由于每次插入的行数不固定，需要在“本期合计-金额（元）”单元格设置动态求和公式，确保每次求和的数据正确。
这是原视频教程中没有的功能，对初学者来说研究了很久才实现。
fzmb.Range("i" & i + 4) = "=sum(i4:i" & i + 3 & ")"动态求和，随插入行数自动变换。
注意：求和列号为 I，而代码中定义了变量 i，存在两个 i，使用时需区分。
Range(“i” & i + 4)
双引号中的 i 表示列号，i+4 表示变量，i=6 时，变量值为 10。
因此 Range(“i” & i + 4) 此时为 Range(“I10”)，即 I10 单元格。
i4:i” & i + 3 & “
求和范围从 I4 到 I(i+3)，即 I4 到 I9。
还有一个动态参数需设置。
随着插入行数变化，“需方：”的单元格地址也会变化。
为准确获取变化后的地址，需系统自动追踪变化后的地址。
fzmb.Range("f" & i + 12) = "需方：" & arr1(k, 1)PS：若单元格固定，可写为：fzmb.Range(“F12”) = “需方：” & arr1(k, 1)
- 自动生成序列号
生成表格后发现，序列号要么乱序，要么跳序。这是由于内容从磅单明细筛选后复制粘贴，序列号仍是原序号。
因此需添加自动生成序列号的代码，研究后代码如下：
fzmb.Range("A4").Select
For i = 1 To i
ActiveCell.Value = i
ActiveCell.Offset(1, 0).Activate
Next i首先定位到 A4 单元格，即开始生成序列号的单元格。
设置 for 循环，沿用变量 i，生成 1 到 i 的序列号。
最终效果如下：
- 另存为独立工作簿
fzmb.Copy
Set wb = ActiveWorkbook
wb.SaveAs Filename:=ThisWorkbook.Path & "\" & arr1(k, 1)
wb.Close复制 fzmb，把当前独立工作簿交给变量 wb，然后另存到当前工作簿所在路径下。
然后删除复制的模板，为生成下一个客户对账单腾出位置。
Application.DisplayAlerts = False
fzmb.Delete
Application.DisplayAlerts = True
y = y + 1设置变量 y，每拆分一个客户对账单，y 加 1，用于提示拆分的对账单总数。
Next k继续对剩余客户执行相同操作，直到循环完成所有客户。
- 提示框
当所有对账单生成完成后，设置提示框。
MsgBox "对账单已拆分完成，一共生成" & y & "个对账单，一共用时" & Timer - t & "秒"通过 MsgBox 函数弹出提示框。
至此，所有代码程序完成。
模板仅供参考，许多细节和功能需根据实际工作需求调试使用。
总之，具体问题具体分析。
以下是完整代码程序，仅供需要的朋友参考学习。
代码程序
Sub 一键生成对账单()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim dqsh As Worksheet, fzmb As Worksheet, mb As Worksheet, sxrg As Range
Dim wb As Workbook, y%, r%, x%, k%, i%, d
Dim arr, arr1
t = Timer
Set d = CreateObject("scripting.dictionary")
Set dqsh = ThisWorkbook.ActiveSheet
Set mb = Sheets("模板")
dqsh.AutoFilterMode = False
r = dqsh.Range("L65536").End(xlUp).Row
arr = dqsh.Range("L3:L" & r)
For x = 1 To UBound(arr)
d(arr(x, 1)) = " "
Next x
arr1 = Application.Transpose(d.keys)
For k = 1 To UBound(arr1)
dqsh.Range("L2").AutoFilter 12, arr1(k, 1)
i = dqsh.Range("L3:L" & r).SpecialCells(xlCellTypeVisible).Cells.Count
mb.Copy after:=Sheets(Sheets.Count)
Set fzmb = ActiveSheet
fzmb.Name = arr1(k, 1)
fzmb.Range("a4").Resize(i).EntireRow.Insert
Set sxrg = dqsh.Range("A2").CurrentRegion
sxrg.Offset(2, 0).Resize(sxrg.Rows.Count - 2).Copy fzmb.Range("A4")
fzmb.Columns("K:O").Delete Shift:=xlToLeft
fzmb.Range("i" & i + 4) = "=sum(i4:i" & i + 3 & ")"
fzmb.Range("f" & i + 12) = "需方：" & arr1(k, 1)
fzmb.Range("A4").Select
For i = 1 To i
ActiveCell.Value = i
ActiveCell.Offset(1, 0).Activate
Next i
fzmb.Copy
Set wb = ActiveWorkbook
wb.SaveAs Filename:=ThisWorkbook.Path & "\" & arr1(k, 1)
wb.Close
Application.DisplayAlerts = False
fzmb.Delete
Application.DisplayAlerts = True
y = y + 1
Next k
dqsh.AutoFilterMode = False
dqsh.Select
Application.ScreenUpdating = True
MsgBox "对账单已拆分完成，一共生成" & y & "个对账单，一共用时" & Timer - t & "秒"
End Sub代码基本能达到预期效果，但部分程序稍显冗杂，还可继续优化。