Как изменить этот код VBA, чтобы он работал на всех листах в моей книге? - PullRequest
0 голосов
/ 08 мая 2018

Я использую 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 выполнялись на всех листах этой книги вместо активной.

Ответы [ 4 ]

0 голосов
/ 08 мая 2018

Вы должны также снова включить обновление экрана после его завершения, т.е.

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
0 голосов
/ 08 мая 2018

Это должно работать для вас. Это просто подпрограмма, которая проходит через каждый лист, а затем запускает ваш код

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
0 голосов
/ 08 мая 2018

Это должно быть немного быстрее, чем перебирать все ячейки:

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
0 голосов
/ 08 мая 2018

Вы можете добавить второй цикл вокруг вашего кода и перебрать все листы своей книги. Как то так

For Each ws In Worksheets

    For Each cell In ws.UsedRange
...