Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Добавление листов в коллекцию - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Добавление листов в коллекцию (Макросы/Sub)
Добавление листов в коллекцию
vzdorny Дата: Вторник, 06.08.2019, 23:04 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 21
Репутация: 0 ±
Замечаний: 0% ±

Excel 2003
Здравствуйте!
Хочу менять цвет ячеек на определённых листах,
реализовав это через коллекции,
но не могу понять, как добавить к коллекции отдельный лист,
а не обрабатывать сразу всю книгу
наваял что-то такое, но не работает
[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]
Как исправить?
Спасибо!


Сообщение отредактировал vzdorny - Вторник, 06.08.2019, 23:05
 
Ответить
СообщениеЗдравствуйте!
Хочу менять цвет ячеек на определённых листах,
реализовав это через коллекции,
но не могу понять, как добавить к коллекции отдельный лист,
а не обрабатывать сразу всю книгу
наваял что-то такое, но не работает
[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]
Как исправить?
Спасибо!

Автор - vzdorny
Дата добавления - 06.08.2019 в 23:04
krosav4ig Дата: Вторник, 06.08.2019, 23:26 | Сообщение № 2
Группа: Друзья
Ранг: Старожил
Сообщений: 2213
Репутация: 921 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Здравствуйте
наваял что-то такое, но не работает
а должно?[vba]
Код
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
[/vba]


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Вторник, 06.08.2019, 23:26
 
Ответить
СообщениеЗдравствуйте
наваял что-то такое, но не работает
а должно?[vba]
Код
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
[/vba]

Автор - krosav4ig
Дата добавления - 06.08.2019 в 23:26
InExSu Дата: Среда, 07.08.2019, 13:14 | Сообщение № 3
Группа: Проверенные
Ранг: Ветеран
Сообщений: 591
Репутация: 71 ±
Замечаний: 0% ±

Excel 2010
Привет!
добавить к коллекции отдельный лист

[vba]
Код
Sub Ws_2_Col_test()
    '
    Dim col As New Collection

    Dim ws As Worksheet
    Set ws = ActiveSheet

    col.Add ws

End Sub
[/vba]


На сохранение второго закона термодинамики: яндекс.кошелёк 410012113235839
 
Ответить
СообщениеПривет!
добавить к коллекции отдельный лист

[vba]
Код
Sub Ws_2_Col_test()
    '
    Dim col As New Collection

    Dim ws As Worksheet
    Set ws = ActiveSheet

    col.Add ws

End Sub
[/vba]

Автор - InExSu
Дата добавления - 07.08.2019 в 13:14
vzdorny Дата: Среда, 07.08.2019, 18:52 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 21
Репутация: 0 ±
Замечаний: 0% ±

Excel 2003
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 - Среда, 07.08.2019, 18:53
 
Ответить
Сообщение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
Дата добавления - 07.08.2019 в 18:52
krosav4ig Дата: Четверг, 08.08.2019, 17:34 | Сообщение № 5
Группа: Друзья
Ранг: Старожил
Сообщений: 2213
Репутация: 921 ±
Замечаний: 0% ±

Excel 2007,2010,2013
[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
[/vba]


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Четверг, 08.08.2019, 17:57
 
Ответить
Сообщение[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
[/vba]

Автор - krosav4ig
Дата добавления - 08.08.2019 в 17:34
vzdorny Дата: Четверг, 08.08.2019, 19:14 | Сообщение № 6
Группа: Пользователи
Ранг: Новичок
Сообщений: 21
Репутация: 0 ±
Замечаний: 0% ±

Excel 2003
krosav4ig, благодарю!
 
Ответить
Сообщениеkrosav4ig, благодарю!

Автор - vzdorny
Дата добавления - 08.08.2019 в 19:14
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Добавление листов в коллекцию (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс цитирования
© 2010-2019 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!