怎么在Excel汇总表中,删除标记颜⾊以外的表格(包括各明细表)?
不得不说,你这个问题有点难,其实也不是难,是恶⼼。对于⼀般的没有VBA基础的⼈,处理
这个问题就是通过⼀步步繁复的操作来实现。
如果说通过筛选去,数据量⼤的话,这个事⽆疑会恶⼼死⼈。
我看这个问题在这有⼀段时间了,但是也没⼈给出靠谱的回答,所以特地写了⼀段代码。经测
试,完全没有问题。
⽽且,这个问题提的也很模糊,不太⽅便给出针对性的做法
对于写VBA代码来说没有说清楚的地⽅有以
下⼏处:
1. 表格中标记的颜⾊是统⼀的颜⾊还是有多种不同的颜⾊
2. 表格中被标记颜⾊的地⽅是对数据区域整⾏标记还是仅对单元格标记
3. 问题中所提到的汇总表和明细表是不是在同⼀个⼯作簿中
4. 删除标记颜⾊以外的表格是单元格删除还是整⾏、整列、或者整sheet删除
5. 有标记颜⾊但是空⽩单元格怎么处理
6. ⼤概有多少的sheet需要处理,有没有⽆标记颜⾊的sheet,有没有空⽩sheet
7. 如果是删除标记颜⾊以外的单元格,那么如果出现空⽩⾏或列,要不要⼀并删除
以上情况都是编写VBA代码需要考虑的地⽅
我这⾥呢,根据给出的模糊问题,简单的写了⼀个⼤概能⽤的宏命令
先说⼀下我的思路:
1. 假设所有表格是在同⼀个⼯作簿中
2. 统计出⼀共有多少个⼯作博,⽤于做循环查询
3. 出每个sheet中没有被标记颜⾊的单元格,并清除单元格格式及内容
4. 如果有未标记颜⾊且⽆任何单元格内容的表格,则给出提⽰,并结束循环
5. 如果需要删除内容之前的空⽩⾏或列,则删除整⾏、整列
下图是我做的实例,有三个Sheet表,每个表格中存在标注了颜⾊的⾏,或单元格:
Sheet1,标题⾏标注颜⾊,数据中整⾏包含不同颜⾊
Sheet2,标题⾏标注颜⾊,数据中⾮整⾏包含不同颜⾊
Sheet3,标题⾏未标注颜⾊,数据中⾮整⾏包含不同颜⾊
VBA编辑器打开⽅法,快捷键:Alt+F11,⼯程区,插⼊,模块
VBA代码图⽰(源码占⽤篇幅较⼤,我放到最后了):
其中
Sub Clear():⽤于清除未标注颜⾊的⾮空单元格
Sub DeleteEmptyRows():⽤于删除空⾏
Sub DeleteEmptyColumns():⽤于删除空列
代码执⾏过程中,只执⾏⼀个⼯程,但通过Sub Clear()⼯程,调⽤了Sub DeleteEmptyRows()和Sub DeleteEmptyColumns()
delete删除表格还是内容我们来看⼀下执⾏代码的效果:
代码执⾏时,为了看效果,我屏蔽了两条返回sheet1的代码
从动图可以看到,代码执⾏的很快,也达到了我们的⽬
1. 清楚了所有未标记颜⾊的单元格
2. 清楚了数据中的冗余空⾏
我再⼀步⼀步执⾏代码,给⼤家看⼀下Excel都⼲了些什么(由于多个sheet处理机制⼀样,这⾥只录制了两个sheet的处理过程慢放):
通过慢放,⼤家应该能看出,代码真的是很蠢的,它也是⼀个⼀个的单元格去删除,然后再去删除⾏。
需要注意的是,如果表格中存在空的sheet,vba会给出⼀个提⽰,如果空表夹杂在有数据的表格中间,
那么代码运⾏到空表的时候会退出,直接给出提⽰,不再向下运⾏。
提⽰如下:
sheet4为⼀个空的表格
对于宏,你也可以再Excel中插⼊⼀个控件,指定到所编写的宏,之后,点击控件即可执⾏宏了。操作⽅法如下:
ok,就这么多吧,代码我写在下边了,没有写注释,如果有感兴趣的朋友可以⾃⼰去研究优化⼀下,或者有什么疑问,评论或私信联系我即可:
横线中间为VBA代码:
--------------------------------------
Sub Clear()
Dim rng As Range, i As Integer
For i = 1 To ActiveWorkbook.Worksheets.Count
ActiveWorkbook.Worksheets(i).Select
For Each rng In ActiveSheet.UsedRange.SpecialCells(2)
On Error GoTo Skip
If rng.Interior.ColorIndex = xlNone Then
rng.Clear
End If
Next
Call DeleteEmptyRows
Call DeleteEmptyColumns
Next
ActiveWorkbook.Worksheets(1).Select
Exit Sub
Skip:
ActiveWorkbook.Worksheets(1).Select
MsgBox '已经没有未标记颜⾊的⾮空单元格'
End Sub
Sub DeleteEmptyRows()
Dim LastRow As Integer, r As Integer
LastRow = ActiveSheet.UsedRange.Rows.Count
LastRow = LastRow + ActiveSheet.UsedRange.Row - 1
For r = LastRow To 1 Step -1
If WorksheetFunction.CountA(Rows(r)) = 0 Then
Rows(r).Delete
End If
Next r
End Sub
Sub DeleteEmptyColumns()
Dim LastColumn As Integer, c As Integer
LastColumn = ActiveSheet.UsedRange.Columns.Count LastColumn = LastColumn + ActiveSheet.UsedRange.Column For c = LastColumn To 1 Step -1
If WorksheetFunction.CountA(Columns(c)) = 0 Then Columns(c).Delete
End If
Next c
End Sub
--------------------------------------
版权声明:本站内容均来自互联网,仅供演示用,请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198,我们将在24小时内删除。
发表评论