如何修改此VBA代码,使其在工作簿中的所有工作表上运行?



我正在使用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

相关内容

最新更新