用列信息批量生成工作表,看这篇就够了

▎写在前面

本文通过一个简单的案例,详细讲解批量生成多个工作表的VBA需求,并考虑可能出现的一些问题,加深对If条件判断的使用。新手建议一步一步根据文章内容进行测试。

▎案例需求

实际需求模拟如下:

以当前工作表作为模板表格,以H列信息作为需要生成的工作表名称,批量生成。

实现代码:

Sub 批量生成工作表() Application.ScreenUpdating = False '取消屏幕刷新,加快速度 Set sht = Worksheets("模板") '将名字为模板的sheet赋值给对象变量sht For i = 2 To sht.Cells(Rows.Count, "h").End(3).Row '对H列数据进行循环 sht.Copy After:=Worksheets(Worksheets.Count) '录制宏可得到该句代码,目的是将模板表复制并且新增作为最后一个表格 Worksheets(Worksheets.Count).Name = sht.Cells(i, "h") '修改sheet的名字为H列的具体单元格名字 Next Application.ScreenUpdating = True '开启屏幕刷新 MsgBox "完成!"End Sub
核心语句:  sht.Copy After:=Worksheets(Worksheets.Count),其中为什么这块是Worksheets.Count ,是因为新建的Sheet默认都是在最后一个。所以可以通过索引号直接获取新建的Sheet。这一句可以通过以下步骤录制宏来获取。

录制宏的语句:

Sub 宏1() Sheets("对照表").Copy After:=Sheets(1)End Sub

代码整体运行结果:

但是现在这种情况有个小问题,就是列信息和模板都在同一个sheet里面,这就导致,生成的sheet里面都包含有多余的信息。我们再加两句删除多余信息的代码即可。
Sub 批量生成工作表() Application.ScreenUpdating = False '取消屏幕刷新,加快速度 Set sht = Worksheets("模板") '将名字为模板的sheet赋值给对象变量sht For i = 2 To sht.Cells(Rows.Count, "h").End(3).Row '对H列数据进行循环 sht.Copy After:=Worksheets(Worksheets.Count) '录制宏可得到该句代码,目的是将模板表复制并且新增作为最后一个表格 Worksheets(Worksheets.Count).Name = sht.Cells(i, "h") '修改sheet的名字为H列的具体单元格名字 Worksheets(Worksheets.Count).Columns("h").Delete'删除H列信息        Worksheets(Worksheets.Count).Shapes("按钮 1").Delete'删除程序执行按钮 Next Application.ScreenUpdating = True '开启屏幕刷新 MsgBox "完成!"End Sub

当然,根据实际情况来,如果把Sheet名列和模板Sheet不在一个Sheet里面的话,就不必这两句删除代码了。

▎变化的情形

▶如果新增的某个Sheet已经存在,程序就会报错。这个时候我们在新增Sheet之前,就要增加一个判断是否已存在相同名字表格的判断。这里,我们使用一个自定义函数IsSheetExisted。

完整代码:

Sub 批量生成工作表2() Application.ScreenUpdating = False '取消屏幕刷新,加快速度 Set sht = Worksheets("模板") '将名字为模板的sheet赋值给对象变量sht For i = 2 To sht.Cells(Rows.Count, "h").End(3).Row '对H列数据进行循环 If IsSheetExisted(sht.Cells(i, "h")) = False Then sht.Copy After:=Worksheets(Worksheets.Count) '录制宏可得到该句代码,目的是将模板表复制并且新增作为最后一个表格 Worksheets(Worksheets.Count).Name = sht.Cells(i, "h") '修改sheet的名字为H列的具体单元格名字 Worksheets(Worksheets.Count).Columns("h").Delete Worksheets(Worksheets.Count).Shapes("按钮 1").Delete End If Next Application.ScreenUpdating = True MsgBox "完成!"End SubFunction IsSheetExisted(tabname As String) As Boolean Dim sht As Worksheet For Each sht In Worksheets If sht.Name = tabname Then IsSheetExisted = True Exit Function End If Next IsSheetExisted = FalseEnd Function

▶如果H列有空单元格,则会造成新建表格命名的时候失败。这个时候我们需要再加1个条件判断,当H列信息不为空的时候,才进行新建Sheet操作。
Sub 批量生成工作表2() Application.ScreenUpdating = False '取消屏幕刷新,加快速度 Set sht = Worksheets("模板") '将名字为模板的sheet赋值给对象变量sht For i = 2 To sht.Cells(Rows.Count, "h").End(3).Row '对H列数据进行循环 If sht.Cells(i, "h") <> "" Then If IsSheetExisted(sht.Cells(i, "h")) = False Then sht.Copy After:=Worksheets(Worksheets.Count) '录制宏可得到该句代码,目的是将模板表复制并且新增作为最后一个表格 Worksheets(Worksheets.Count).Name = sht.Cells(i, "h") '修改sheet的名字为H列的具体单元格名字 Worksheets(Worksheets.Count).Columns("h").Delete Worksheets(Worksheets.Count).Shapes("按钮 1").Delete End If End If Next Application.ScreenUpdating = True MsgBox "完成!"End SubFunction IsSheetExisted(tabname As String) As Boolean Dim sht As Worksheet For Each sht In Worksheets If sht.Name = tabname Then IsSheetExisted = True Exit Function End If Next IsSheetExisted = FalseEnd Function
各种情形都写出来了,最重要的不是代码本身,是根据各种情况,如何使用条件语句判断的逻辑才是核心。
(0)

相关推荐