提示：程序代码是根据实际工作的需求编写的，仅供参考学习使用。

文章目录

一、问题描述
二、代码程序
三、总结
四、仍需要解决的问题

一、问题描述

Excel VBA一键批量生成对账单

前不久，由于内人工作上的需要，开始接触并研究起Excel VBA的使用。

从EPR系统里导出的客户数据，一张表格里有几十家甚至上百家业务往来单位，要按照对应的单位名称生成单独的一张对账单表格。如果按照常规的复制粘贴来处理，一家单位处理下来少说也得五六分钟。不仅工作效率低，而且很浪费时间，严重影响其他工作的开展。

在网上搜索方法教程，无意中看到可以通过Excel VBA来批量生成对账单，只要把代码编写好，只需要一键便可以轻松完成几个小时的工作量。

从零接触到零基础，边解读代码边学习基础知识，渐渐熟悉每一行代码的含义和可以实现的功能，然后再根据实际工作去调试原视频的代码，并自行编写满足工作需求的代码，经过无数次的调试失败，修改代码，最终实现了通过VBA一键批量生成对账单。

对账单及模板表格

最终实现的效果

二、代码程序

操作软件：Microsoft Office Excel 2021
使用功能：Visual Basic

Sub 一键生成对账单()'屏幕刷新（ScreenUpdating），作用是使Excel停止刷新，提高代码的执行速度。
Application.ScreenUpdating = False
'屏蔽弹窗提示
Application.DisplayAlerts = False'dqsh当前工作表 fzmb复制模板 mb模板 sxrg筛选
Dim dqsh As Worksheet, fzmb As Worksheet, mb As Worksheet, sxrg As Range
Dim wb As Workbook, y%, r%, x%, k%, i%, d    '申明wb为工作簿对象 %短整型 d字典对象
Dim arr, arr1   '作为存储区域的数组
t = Timer  '记录代码运行的起始时间Set d = CreateObject("scripting.dictionary")   '创建字典对象
Set dqsh = ThisWorkbook.ActiveSheet    '把当前工作簿的活动工作表交给dqsh
Set mb = Sheets("模板")   '把模板这张工作表赋值给mbdqsh.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 xarr1 = Application.Transpose(d.keys)  '把字典中的客户名称转置后放到新数组arr1里
For k = 1 To UBound(arr1)dqsh.Range("L2").AutoFilter 12, arr1(k, 1) '筛选操作 AutoFilter 12 自动筛选第12列 arr1(k, 1)筛选的条件i = dqsh.Range("L3:L" & r).SpecialCells(xlCellTypeVisible).Cells.Count  '利用SpecialCells定位L列可见单元格的数量，然后赋值给变量imb.Copy after:=Sheets(Sheets.Count)  '赋值模板这张工作表Set fzmb = ActiveSheet  '把复制的模板交给变量fzmbfzmb.Name = arr1(k, 1)  '设置复制后的工作表名称fzmb.Range("a4").Resize(i).EntireRow.Insert  '在复制的模板里插入i行 EntireRow整行 Insert插入Set sxrg = dqsh.Range("A2").CurrentRegion  '把A2单元格所在的连续区域交给变量sxrg ，CurrentRegion 单元格的当前区域sxrg.Offset(2, 0).Resize(sxrg.Rows.Count - 2).Copy fzmb.Range("A4")    'Offset(2, 0)向下偏移2行，Rows.Count - 2 在原有的基础上减去后面2行空白行，复制好后粘贴到模板的A4单元格fzmb.Columns("K:O").Delete Shift:=xlToLeft    'Columns("K:O").Delete 删除模板中K列到O列的数据，Shift:=xlToLeft 表示删除单元格后，右面的单元格左移填充fzmb.Range("i" & i + 4) = "=sum(i4:i" & i + 3 & ")"    '动态求和，随着插入的行数自动变换，i4:i" & i + 3 & " 求和范围从I4单元格到I(i+3)单元格fzmb.Range("f" & i + 12) = "需方： " & arr1(k, 1)    '动态参数，若单元格是固定的，可写成 fzmb.Range("F12") = "供方： " & arr1(k, 1)fzmb.Range("A4").Select '定位到A4单元格，从A4单元格开始自动生成序列号For i = 1 To i '设置for循环，生成1到i的序列号ActiveCell.Value = i '将i的值交给当前激活的单元格ActiveCell.Offset(1, 0).Activate '向下偏移一行Next ifzmb.Copy  '将上面处理好的模板生成一个独立的工作簿Set wb = ActiveWorkbook  '把当前独立的工作簿交给变量wbwb.SaveAs Filename:=ThisWorkbook.Path & "\" & arr1(k, 1)  '把工作簿另存为到当前工作簿所在的路径下wb.Close  '关闭工作簿Application.DisplayAlerts = False  '屏蔽警告窗口fzmb.Delete  '删除复制的模板Application.DisplayAlerts = True  '打开警告窗口y = y + 1  '每拆分一个客户就给变量y加上1，用于后面提示拆分的客户对账单总数
Next k  '继续对剩余客户执行上面同样的操作，直到把所有客户循环完dqsh.AutoFilterMode = False  '取消筛选
dqsh.Select  '回到账单主表
Application.ScreenUpdating = True  '打开屏幕刷新
MsgBox "对账单已拆分完成，一共生成" & y & "个对账单，一共用时" & Timer - t & "秒"  '通过msgbox弹出提示框End Sub

三、总结

筛选操作时，要注意筛选数据的列号是否发生变化。

 dqsh.Range("L2").AutoFilter 12, arr1(k, 1)

AutoFilter 12 自动筛选第12列的数据，如果表格内的数据列发生变化，要记得更改。

定位最后一行，获取总的行号数。

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。

所以还有另外一种写法，也是最常用的写法 。

方法3：

MsgBox "A列最后一个非空单元格行号为：" & Cells(Rows.Count, 1).End(xlUp).Row

动态求和，随着插入的行数自动变换。

fzmb.Range("i" & i + 4) = "=sum(i4:i" & i + 3 & ")"

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 到 I7。

自动生成序列号。

由于内容是在磅单明细筛选后复制粘贴过来的，序列号还是原来的序号。为了在新生成的对账单里能自动更新序列号，所以还得设置一个自动生成序列号的代码。

fzmb.Range("A4").Select For i = 1 To iActiveCell.Value = iActiveCell.Offset(1, 0).ActivateNext i

首先定位到A4单元格，即开始生成序列号的单元格。设置一个for循环，沿用上面的变量i，生成1到i的序列号。

四、仍需要解决的问题

上述代码虽然可以帮助我一键批量生成对账单，大致上是能解决目前的问题，但是仍有一些后续问题有待解决。

由于一个客户我设计一个总的工作簿，每个月对账单对应的工作表都需要保存在同一个工作簿里。而目前代码所实现的只是将当月的对账单生成一个新的工作簿，而不会自动打开总的客户工作簿将当月的数据添加进去。

目前最笨的办法就是： 先打开一个客户总的工作簿，然后再打开当月生成的对账单，复制粘贴到总的工作簿里，保存关闭。

上百家客户如此笨拙地操作下来，几个小时又没了。

所以接下来要解决的问题就是：

在生成对账单的过程中，如果是老客户，会自动按照客户名称找到总的工作簿，打开并把当月的数据添加进去。

如果是新客户的话，则是在模板工作簿所在的路径下生成新的对账单。

Excel VBA | 一键批量生成对账单相关推荐

datatable如何生成级联数据_如何把Excel表数据批量生成条形码
条形码属于一维条码,是将宽度不等的多个黑条和空白,按照一定的编码规则排列,用以表达一组信息的图形标识符,条形码的种类比较多,比如常用的Code128码,Code39码,Code93码,EAN-13码, ...
Excel与bat批量生成文件夹，修改文件夹名称
用Excel与bat批量生成文件夹,修改文件夹名称一.批量生成文件夹 excel一列输入文件名序列:另一列用公式生成要写入bat文件的序列,之后复制该列写入.txt文件,保存为.bat文件,双击运行 ...
利用Pajek软件批量处理excel数据，批量生成网络关系图
利用Pajek软件批量处理excel数据,批量生成网络关系图 Pajek软件大家想必都不陌生,但是我很陌生,因为我用它不是进行网络分析,而是用它来画关系图(类似网络图).但是Pajek软件手工操作时一 ...
Python+Excel+VBA实现批量自助生成名牌
文章目录需求在Excel制作名牌批量导出图片 1. 全VBA 2. VBA+压缩包 3. Python+Excel 打包需求这次是hrbp小姐姐需要找我批量生成他们新部门的员工名牌.如果让设 ...
[Excel VBA]如何批量產出QRcode?
QRcode常應用於產品上,不論是為了控管產品工序節點.或是控管產品售後質量,甚至是為了觸及更多消費者的行銷推廣活動.然而,QRcode標籤的產出往往受制於標籤設備的應用程式(當然也有不少方式可以解, ...
获取子文件夹后缀_后期制作老司机教你一键批量生成项目文件夹
我猜你的项目工程是这样的,当你老板说去修改一下之前几个月的工程的时候,你都不知道哪个工程才是最终版呀. 乱糟糟的工程而且当你打开工程的时候,wo艹,素材怎么丢失了~~ 不管是后期制作者还是平常我们日 ...
Excel如何快速批量生成指定性别的随机姓名
在工作中我们可能要生成指定性别的随机姓名,比如生成男性的姓名或者女性的姓名.下面就给大家分享一种快速方法.(下图为完成操作过程) 1.如下图,我们要快速批量生成男生姓名和女生姓名. 2.点击DIY工具 ...
Excel·VBA一键计算每月合计
<vba吧提问-怎么写每月合计的代码>,对表格中每月合计的行进行计算 Sub 选中列每月合计()'适用单/多列选中.单/多列部分选中Dim rng As Range, first_row, ...
Python自动化办公:读取Excel数据并批量生成合同，高效办公，快速回家
前言在我们的工作中,面临着大量的重复性工作,通过人工方式处理往往耗时耗力易出错.而Python在自动化办公方面具有极大的优势,可以解决我们工作中遇到的很多重复性问题,分分钟搞定办公需求.快速下班回 ...
Python实现读取Excel表内容批量生成二维码
目录一.概述二.依赖库安装三.Execl内容四.代码片段五.demo下载连接一.概述最近由于工作原因,需要用到大量二维码,如果用某料二维码生成器生成的话,要么一个一个生成,要么花钱开会员 ...

Excel VBA | 一键批量生成对账单