我正在使用Excel 2016
,我有以下VBA
代码,这些代码删除了活动工作表所有单元格中的突出显示(基于提供的RGB
数字(。
Sub RemoveSpecificColorFill()
'PURPOSE: Remove a specific fill color from the spreadsheet
Dim cell As Range
'Turn off ScreenUpdating (speeds up code)
Application.ScreenUpdating = False
'Loop through each cell in the ActiveSheet
For Each cell In ActiveSheet.UsedRange
'Check for a specific fill color
If cell.Interior.Color = RGB(255, 255, 0) Then
'Remove Fill Color
cell.Interior.Color = xlNone
End If
Next cell
End Sub
我想更新代码,以便VBA
代码在该工作簿中的所有工作表上运行,而不是在活动工作表上运行。
这应该比遍历所有单元格快一点:
Sub RemoveSpecificColorFill()
Dim ws As Worksheet
With Application
.FindFormat.Clear
.ReplaceFormat.Clear
.FindFormat.Interior.Color = RGB(255, 255, 0)
.ReplaceFormat.Interior.Color = xlNone
For Each ws In ThisWorkbook.Worksheets
ws.Cells.Replace What:="", Replacement:="", SearchFormat:=True, ReplaceFormat:=True
Next ws
.FindFormat.Clear
.ReplaceFormat.Clear
End With
End Sub
您可以围绕代码添加第二个循环,并循环访问工作簿的所有工作表。像这样的东西
For Each ws In Worksheets
For Each cell In ws.UsedRange
这应该适合您。它只是一个遍历每个工作表然后运行代码的子
Sub forEachWs()
application.screenupdating = false
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
Call RemoveSpecificColorFill(ws)
Next
application.screenupdating = true
End Sub
Sub RemoveSpecificColorFill(ws As Worksheet)
'PURPOSE: Remove a specific fill color from the spreadsheet
Dim cell As Range
'Loop through each cell in the ActiveSheet
For Each cell In ws.UsedRange
'Check for a specific fill color
If cell.Interior.Color = RGB(255, 255, 0) Then
'Remove Fill Color
cell.Interior.Color = xlNone
End If
Next cell
End Sub
您还应该在完成后重新打开屏幕更新,即
Sub RemoveSpecificColorFill()
'PURPOSE: Remove a specific fill color from the spreadsheet
Dim cell As Range, wks As Worksheet
'Turn off ScreenUpdating (speeds up code)
Application.ScreenUpdating = False
For Each wks In ThisWorkbook.Worksheets
'Loop through each cell in the ActiveSheet
For Each cell In wks.UsedRange
'Check for a specific fill color
If cell.Interior.Color = RGB(255, 255, 0) Then
'Remove Fill Color
cell.Interior.Color = xlNone
End If
Next cell
Next wks
Application.ScreenUpdating = True
End Sub