Sub DeleteWorksheetsWithCertainColorsAndAllZeroOrEmptyCharacters()
Dim ws As Worksheet
Dim rng As Range
Dim lastRow As Long
Dim deleteWorksheet As Boolean
Dim red As Long, green As Long, blue As Long
Dim cellValue As String
Dim redCellsAllZero As Boolean, greenCellsAllZero As Boolean, blueCellsAllZero As Boolean
Application.ScreenUpdating = False ' 禁止屏幕更新,加快运行速度
For Each ws In ThisWorkbook.Worksheets
deleteWorksheet = False
redCellsAllZero = True
greenCellsAllZero = True
blueCellsAllZero = True
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row ' 获取最后一行
' 检查工作表中是否存在指定颜色的单元格
For Each rng In ws.Range("A3:A" & lastRow) ' 从第三行开始检查
red = rng.Interior.Color Mod 256
green = (rng.Interior.Color \ 256) Mod 256
blue = (rng.Interior.Color \ 256 \ 256) Mod 256
If (red = 214 And green = 246 And blue = 239) Or _
(red = 251 And green = 238 And blue = 196) Or _
(red = 255 And green = 255 And blue = 255) Then
' 检查颜色单元格内的字符是否是0或者不存在
cellValue = Trim(rng.Value)
If cellValue <> "" And cellValue <> "0" Then
redCellsAllZero = False
End If
If red = 214 And green = 246 And blue = 239 Then
greenCellsAllZero = False
End If
If red = 251 And green = 238 And blue = 196 Then
greenCellsAllZero = False
End If
If red = 255 And green = 255 And blue = 255 Then
blueCellsAllZero = False
End If
End If
Next rng
' 检查如果存在某一种颜色的单元格,但对应颜色的单元格内字符是0或者不存在,则删除此表格
If (redCellsAllZero Or greenCellsAllZero Or blueCellsAllZero) Then
deleteWorksheet = True
End If
' 删除不符合条件的工作表
If deleteWorksheet Then
Application.DisplayAlerts = False ' 禁止警告框
ws.Delete
Application.DisplayAlerts = True
End If
Next ws
Application.ScreenUpdating = True ' 恢复屏幕更新
MsgBox "删除完成!", vbInformation
End Sub
相似问题