Excel VBA | 一键批量生成对账单（功能优化版本）

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

---

一、代码优化问题说明

操作软件：Microsoft Office Excel 2021
使用功能：Visual Basic（开发工具--visualbasic编辑器--新建模块）

前期写过一篇《VBA实用基础程序 | 一键批量生成对账单》的文章，虽然可以帮助我一键批量生成对账单，大致上是能解决目前的问题，但是仍有一些后续问题有待解决。

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

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

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

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

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

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

---

二、代码更新

1. 编写一个能自动访问客户往期对账单总表，打开、修改数据并保存的代码。

先设置一个for循环来遍历对账单总表文件夹里的文件，通过if函数判断文件名称是否存在于文件夹里。

• 如果存在的话，就表示该客户为老客户，然后对文件进行打开、修改、保存等操作。

• 如果不存在时，就表示该客户为新客户，后续对其进行另存为新对账单的操作。

'代码更新:
'如果是已经存在的老客户，找到往期对账单，将最新一期的数据添加进去
'如果是新客户，则重新生成对账单
Dim fso As New FileSystemObject '因为定义了FileSystemObject，所以要先在vb窗口中，选择工具-引用-勾选Microsoft Scripting Runtime
Dim objFile, objFolder
Dim pathw '定义变量，用于存储对账单总表的地址
Dim wt
pathw = "C:\Users\ZWYB\Desktop\程序编写文件夹\对账单总表\" '注意结尾处有"\"
Set objFolder = fso.GetFolder(pathw)
    For Each objFile In objFolder.Files '用一个for循环不断读取文件夹里面的文件
        If InStr(objFile.Name, arr1(k, 1)) = 1 Then '判断文件夹里面的文件名称是否为当前arr1数组中的名称，如果是则执行下面操作
        Set wt = Workbooks.Open(objFile.Path) '打开文件
        fzmb.Copy after:=Worksheets(Worksheets.Count) '复制模板内容到当前arr1(k, 1)所在的工作簿中
        Worksheets(arr1(k, 1)).Name = Format(Date, "mm月") '利用format函数获取当前月份，如果需要获取完整日期：yyyy年mm月dd日
        'Worksheets(arr1(k, 1)).Name = “9月” '备选：灵活选择按何种方式命名工作表的名称
        ActiveWorkbook.Save '保存
        ActiveWorkbook.Close '关闭
        Application.DisplayAlerts = False  '屏蔽警告窗口
            fzmb.Delete  '删除复制的模板
        Application.DisplayAlerts = True  '打开警告窗口        
        End If
    Next
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

---

2. 新客户另存为独立对账单的代码。

在原来的代码中，已经有生成对账单的代码，在此基础上稍加修改即可。

用MsgBox函数 来提示是否有新客户的产生，当有新客户存在时，就会自动弹出提示选项框，通过选择“确定”或者“取消”来进行下一步操作。

• 当点击“确定”按钮时，系统就会自动将新客户的对账单表生成独立的工作簿，并保存在当前路径下。

• 当点击“取消”按钮时，不进行任何操作。

此外，所有新客户的工作表都保存完后，要在模板工作簿中将其删除，当工作表的名字不为“模板”和“榜单明细”时，执行删除操作。

'新客户对账单生成代码
1