怎么在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()

我们来看一下执行代码的效果：

代码执行时，为了看效果，我屏蔽了两条返回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

--------------------------------------