首页
学习
活动
专区
工具
TVP
发布
社区首页 >问答首页 >各位大佬修复VBA运行时错误70权限被拒绝?

各位大佬修复VBA运行时错误70权限被拒绝?

提问于 2024-03-08 20:08:56
回答 2关注 0查看 110

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

相关文章

相似问题

相关问答用户
领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档