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
尝试写入写保护磁盘或访问锁定文件。 此错误具有以下原因和解决方法:
大佬们我的需求是这个:我想实现工作簿中的表格范围不包括第一二行,检查工作表表格中是否存在单元格颜色通道值为红色214绿色246蓝色239的单元格或者单元格颜色通道值为红色251绿色238蓝色196的单元格或者单元格颜色通道值为红色255绿色255蓝色255的单元格。若表格中单元格存在以上三种单元格通道颜色的任意一种,则寻找在表格内这三种颜色通道值的全部单元格内的字符是否是0或者不存在或者有的是0有的不存在,若是0或者不存在或者有的是0有的不存在则删除此表格,否则保留