Здравствуйте.
В первом столбце расположены ячейки с настроенным цветом фона. Диапазон "A3:A7" и "A15:A21"
Я хочу при помощи макроса закрасить всю строку в фон ячейки первого столбца.
Цвета в первом столбце расположены произвольно.
Через команду print activecell.Interior.Color
узнал номера цветов в первом столбце:
6299648
8092539
13998939
10921638
5395026
При запуске (макроса) вся строка в указанном диапазоне закраситься в цвет ячейки из первого столбца "6299648".
Следующая строка закрасится в цвет "8092539" и т.д.
Макрос
Sub макрос()
'1. Отключение монитора, чтобы ускорить макрос и чтобы не мерцало.
Application.ScreenUpdating = False
'2. Закраска.
color Range("A3:A7")
color Range("A15:A21")
'3. Вкл. монитора.
Application.ScreenUpdating = True
End Sub
Private Sub color(rng As Range)
Dim cell As Range
' Цикл по ячейкам.
For Each cell In rng.Cells
' Закраска.
cell.EntireRow.Interior.color = cell.Interior.color
Next cell
End Sub
Большое Вам - Спасибо!!!
Вот попробовал применить макрос ко всем страницам....
Код:
Спойлер
Sub color_all_sheets()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
'1. ?????????? ????????, ????? ???????? ?????? ? ????? ?? ???????.
Application.ScreenUpdating = False
'2. ????????.
color ws.Range("A1:A3000")
'3. ???. ????????.
Application.ScreenUpdating = True
Next
End Sub
Private Sub color(rng As Range)
Dim cell As Range
' ???? ?? ???????.
For Each cell In rng.Cells
' ????????.
cell.EntireRow.Interior.color = cell.Interior.color
Next cell
End Sub
Перед копированием кода, переключайте язык у клавиатуры на русский, чтобы не искажался русский текст.
Сейчас у вас выключается и включается монитор при работе с каждым листом. В этом нет необходимости. Достаточно выключать и включать монитор один раз:
Макрос
Sub color_all_sheets()
Dim ws As Worksheet
'1. ?????????? ????????, ????? ???????? ?????? ? ????? ?? ???????.
Application.ScreenUpdating = False
' Цикл по листам.
For Each ws In ActiveWorkbook.Worksheets
'2. ????????.
color ws.Range("A1:A3000")
Next
'3. ???. ????????.
Application.ScreenUpdating = True
End Sub
Private Sub color(rng As Range)
Dim cell As Range
' ???? ?? ???????.
For Each cell In rng.Cells
' ????????.
cell.EntireRow.Interior.color = cell.Interior.color
Next cell
End Sub