打开APP
userphoto
未登录

开通VIP,畅享免费电子书等14项超值服

开通VIP
Excel VBA 7.54按照工作表名称拆分工作表,同时增加不存在工作表

一起学习,一起进步~~

今天我们继续来分享下关于工作表的拆分的场景,今天的这个场景是另外一个小伙伴给我提供的场景,他针对的工作场景和我们之前的普通的拆分又有点不一样的,这里在进行单个工作表的拆分的过程中,还需要寻找对应的工作表,并且将对应的数据补充进去,如果恰好,某个分类的工作表在工作表中不存在还需要自动添加对应的工作表,好像有点挑战性,我们来一起看看

场景说明

老规矩,我们依然是来模拟下数据源,根据实际的工作场景来进行分析

这是我们手上的数据表,留意数据表中的不同,工作表中总共有有5个工作表,一个总表,剩下的4个是分表,但是分表中有一个高三10班在我们的总表数据源中是不存在的,相对的,在我们的总表数据元中,也有一个高四年级是不存在的,但是高四年级是有数据的,这里我们来看看如何实现拆分,又不造成数据的流失、

代码区

来看看代码吧

Sub ss()Dim rng As Range, firstr As Range, sth As Worksheet, str$, sthf As WorksheetSet sthf = ActiveSheetSet rng = Application.InputBox("请选择表头区域", "表头区域的确定", , , , , , 8)TitleR = rng.Rows.CountTitleC = rng.ColumnTitleColNum = rng.Columns.Countstr = InputBox("请输入拆分标准列的列数")num = Int(str)l = ActiveSheet.Cells(Rows.Count, TitleR).End(xlUp).RowSet firstr = Cells(TitleR + 1, num)For i = TitleR + 2 To l + 1 If Cells(i, num) <> firstr Thenline: For Each sth In Worksheets k = k + 1 If sth.Name = firstr Then l1 = sth.Cells(Rows.Count, 1).End(xlUp).Row Range(firstr.Offset(0, -1), Cells(i - 1, TitleColNum + TitleR - 1)).Copy sth.Cells(l1 + 1, 1) Set firstr = Cells(i, num) k = 0 Exit For Else If k = Worksheets.Count Then Worksheets.Add after:=Worksheets(Worksheets.Count) rng.Copy ActiveSheet.Cells(1, 1) ActiveSheet.Name = firstr sthf.Activate k = 0 GoTo line End If End If Next sth End IfNext iEnd Sub

并不算是太长,我们这里来看看代码执行的过程

老规矩,先来选择下表头

然后我们在确定下拆分标准的列数

然后就可以出结果了,来看看

看看并不存在的高四年级如何

新建了工作表,并且增加了数据

那么完全不存在的高三10班呢

刚刚静静,没有添加任何数据,达到了我们的要求。 

代码分析

来一起分析下今天的代码

前面的代码比较的简单,大家应该都懂了,我们直接进入正题

Set firstr = Cells(TitleR + 1, num)

和之前写法有些类似,这里又是指向具体的某个单元格,我们来定位下

定位到了,它就是班级的第一个单元格,然后我们开始往下循环,当寻找到第一个不等于firstr的时候,证明数据区找到了,

上面的一系列的数据班级都是等于firstr,然后我们去下面的工作表中寻找班级名字为 firstr的工作表。

然后获取这个工作表的总行数,然后填充数据

l1 = sth.Cells(Rows.Count, 1).End(xlUp).RowRange(firstr.Offset(0, -1), Cells(i - 1, TitleColNum + TitleR - 1)).Copy sth.Cells(l1 + 1, 1)

这个对大家来说,应该已经没有难度了,毕竟这个区域的获取和探索,我们已经前后进行了好几节了。 

然后我们还需要做一件事,重新定义firstr,将它赋值为新的班级的值,以方便我们进行下一个循环

Set firstr = Cells(i, num)

但是如果碰到了不存在的工作表怎么办,这里有高四年级,但是我们的工作表没有高四年级,所以我们要新增一个工作表,新增工作表的操作很简单的,大家都熟悉了,但是这里有一个重点就是如何判断是循环完了所有的工作表呢?

我们这里声明一个变量k ,用它来记录我们循环的次数,如果当k刚好等于Worksheets.Count,就是工作表的总数的时候,就代表了循环了所有的工作表了,这个时候如果都没有找到合适的工作表,那就是证明真的不存在这样的工作表,然后我们就可以创建符合条件的工作表了。 

Worksheets.Add after:=Worksheets(Worksheets.Count)rng.Copy ActiveSheet.Cells(1, 1)ActiveSheet.Name = firstr

有了符合条件的工作表之后呢,这里有两种选择,你可以新建工作表+数据填充两个动作写在一起,不过这样就是会导致代码比较的长,有点不好看,

或者你可以选择和我一样,用 GoTo line进行调转,重新进行一次循环

重新进行循环的时候,我们新增加的工作表已经进入到worksheets里面了,他就会循环到我们新增的工作表并且填充数据了。

这里很多的前辈都说GOTO这个方法最好不好使用,但是我个人的理解是偶尔在程序中使用一个是没有问题的,他可以节省我们的代码量,但是大量的使用,我也是不推荐的,这点大家可以根据自己的需要选择使用。

==============================

本节课的案例源码已经上传,需要的小伙伴后台私信“7-54-H6”,希望大家多支持~~,多多关注 ~ ~

好了,明晚21:00,准时再见!

因为公众号没有留言功能(开的比较晚),所以建立一个线下微信群,主要为大家提供一个交流的平台,同时大家也可以提一些对公众号的意见和看法,大家一起学习,一起进步。

本站仅提供存储服务,所有内容均由用户发布,如发现有害或侵权内容,请点击举报
打开APP,阅读全文并永久保存 查看更多类似文章
猜你喜欢
类似文章
【热】打开小程序,算一算2024你的财运
Excel VBA 7.58以多列为标准拆分数据,掌握方法,N个标准都能拆
VBA|多个工作表中的数据自动合并到一个工作表
VBA语句集(2)
VBA专题11:详解UsedRange属性
VBA实用小程序19:合并工作簿中的所有工作表
30个有用的Excel VBA代码
更多类似文章 >>
生活服务
热点新闻
分享 收藏 导长图 关注 下载文章
绑定账号成功
后续可登录账号畅享VIP特权!
如果VIP功能使用有故障,
可点击这里联系客服!

联系客服