Здравствуйте! Хочу менять цвет ячеек на определённых листах, реализовав это через коллекции, но не могу понять, как добавить к коллекции отдельный лист, а не обрабатывать сразу всю книгу наваял что-то такое, но не работает [vba]
Код
Dim L As Range Dim MyCollection As New Collection MyCollection.Add Лист3 MyCollection.Add Лист4 For Each L In MyCollection If L.Interior.Color = vbRed Then L.Interior.Color = vbBlue Next L
[/vba] Как исправить? Спасибо!
Здравствуйте! Хочу менять цвет ячеек на определённых листах, реализовав это через коллекции, но не могу понять, как добавить к коллекции отдельный лист, а не обрабатывать сразу всю книгу наваял что-то такое, но не работает [vba]
Код
Dim L As Range Dim MyCollection As New Collection MyCollection.Add Лист3 MyCollection.Add Лист4 For Each L In MyCollection If L.Interior.Color = vbRed Then L.Interior.Color = vbBlue Next L
Dim sh As Worksheet For Each sh In Sheets(Array("Лист3", "Лист4")) With sh.UsedRange.Interior If .Color = vbRed Then .Color = vbBlue Else .Color = vbRed End With Next
Dim sh As Worksheet For Each sh In Sheets(Array("Лист3", "Лист4")) With sh.UsedRange.Interior If .Color = vbRed Then .Color = vbBlue Else .Color = vbRed End With Next
InExSu, благодарю за точный ответ! К сожалению, я понял, что моя проблема всё же несколько шире обозначенного вопроса
krosav4ig, спасибо, но получается не совсем то, что пытался изобразить я: у вас выходит, что если весь используемый диапазон на листах 3 и 4 красный, то его нужно полностью покрасить в синий, а если например красная только одна ячейка, весь используемый диапазон красится в красный цвет. Я же пытался на этих листах поменять цвет только красным ячейкам на синий то есть что-то вроде [vba]
Код
Dim x As Range For Each x In ThisWorkbook.Worksheets("Лист3").UsedRange If x.Interior.Color = vbRed Then x.Interior.Color = vbBlue Next
For Each x In ThisWorkbook.Worksheets("Лист4").UsedRange If x.Interior.Color = vbRed Then x.Interior.Color = vbBlue Next
[/vba] только я хотел использовать для этих целей коллекции Нельзя так делать? и ещё пытался обращаться к листам по кодовому имени (вдруг пользователь их переименует?) Извиняюсь, что сразу не сформулировал задачу более чётко
InExSu, благодарю за точный ответ! К сожалению, я понял, что моя проблема всё же несколько шире обозначенного вопроса
krosav4ig, спасибо, но получается не совсем то, что пытался изобразить я: у вас выходит, что если весь используемый диапазон на листах 3 и 4 красный, то его нужно полностью покрасить в синий, а если например красная только одна ячейка, весь используемый диапазон красится в красный цвет. Я же пытался на этих листах поменять цвет только красным ячейкам на синий то есть что-то вроде [vba]
Код
Dim x As Range For Each x In ThisWorkbook.Worksheets("Лист3").UsedRange If x.Interior.Color = vbRed Then x.Interior.Color = vbBlue Next
For Each x In ThisWorkbook.Worksheets("Лист4").UsedRange If x.Interior.Color = vbRed Then x.Interior.Color = vbBlue Next
[/vba] только я хотел использовать для этих целей коллекции Нельзя так делать? и ещё пытался обращаться к листам по кодовому имени (вдруг пользователь их переименует?) Извиняюсь, что сразу не сформулировал задачу более чёткоvzdorny
Сообщение отредактировал vzdorny - Среда, 07.08.2019, 18:53
Option Explicit Function UsedRangeByCodeName(sCodeName$) As Range Set UsedRangeByCodeName = ThisWorkbook.VBProject. _ VBComponents(sCodeName). _ Properties("usedrange").Object End Function Sub test() Dim MyCollection As New Collection Dim v, r As Range, r1 As Range, r2 As Range, addr$ For Each v In Array("Лист3", "Лист4") MyCollection.Add UsedRangeByCodeName(CStr(v)), v Next With Application.FindFormat .Clear With .Interior .PatternColorIndex = xlAutomatic .Color = vbBlue .TintAndShade = 0 .PatternTintAndShade = 0 End With End With For Each r In MyCollection Set r1 = r.Find(What:="", After:=r(1, 1), LookIn:=xlFormulas, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _ , SearchFormat:=True) If Not r1 Is Nothing Then addr = r1.Address Set r2 = r1 Do If r1.Address <> addr Then Set r2 = Union(r2, r1) Set r1 = r.Find(What:="", After:=r1, LookIn:=xlFormulas, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _ , SearchFormat:=True) Loop While Not r1 Is Nothing And r1.Address <> addr End If If Not r2 Is Nothing Then r2.Interior.Color = 255: Set r2 = Nothing Next End Sub
[/vba]
[vba]
Код
Option Explicit Function UsedRangeByCodeName(sCodeName$) As Range Set UsedRangeByCodeName = ThisWorkbook.VBProject. _ VBComponents(sCodeName). _ Properties("usedrange").Object End Function Sub test() Dim MyCollection As New Collection Dim v, r As Range, r1 As Range, r2 As Range, addr$ For Each v In Array("Лист3", "Лист4") MyCollection.Add UsedRangeByCodeName(CStr(v)), v Next With Application.FindFormat .Clear With .Interior .PatternColorIndex = xlAutomatic .Color = vbBlue .TintAndShade = 0 .PatternTintAndShade = 0 End With End With For Each r In MyCollection Set r1 = r.Find(What:="", After:=r(1, 1), LookIn:=xlFormulas, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _ , SearchFormat:=True) If Not r1 Is Nothing Then addr = r1.Address Set r2 = r1 Do If r1.Address <> addr Then Set r2 = Union(r2, r1) Set r1 = r.Find(What:="", After:=r1, LookIn:=xlFormulas, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _ , SearchFormat:=True) Loop While Not r1 Is Nothing And r1.Address <> addr End If If Not r2 Is Nothing Then r2.Interior.Color = 255: Set r2 = Nothing Next End Sub