Выбрать дату в календареВыбрать дату в календаре

Страницы: 1
Макрос: найти одинаковые значения и отметить их цветом
 
Уважаемый Hugo, и другие форумчане!
Передо мной стоит очень много задач, которые нужно реализовать с помощью макросов, но в силу того, что не красиво каждый раз просить готовый код, я стараюсь разбираться в кодах сам, дабы в будущем их (т.е. коды) самому и создавать.
Так вот, хочу вернуться к предыдущему коду, а именно этот код я для себя дополняю где можно всякими комментариями и примечаниями, и на данный момент код выглядит вот так (с моими комментами):
Код
Private Sub CommandButton1_Click()
    Dim color1 As Range, arr    '-задаем переменную color1 тип данных - range (т.е. как диапазон данных) (используя оператор Dim) для последующих операций со строками, а также переменную arr, которую не привязываем ни к одному типу
    
    With CreateObject("scripting.dictionary") '-создаем объект Dictionary, и работаем с ним с помощью оператора With
        For Each color1 In Sheets("Список").[a1].CurrentRegion.Columns(1).Cells
            .Item(color1.Value) = color1.Interior.Color & "|" & color1.Interior.Pattern & "|" & color1.Interior.PatternColor '-с помощью команды Item мы записываем в созданный объект Dictionary данные про цвет, штриховку и цвет штриховки каждой ячейки в столбце А (т.е. 1).
        Next

        Sheets("Календарь").UsedRange.Cells.Interior.Color = xlNone '-обнуляем все цвета, перед тем как создать новые. Т.е. каждый раз при обновлении - мы заново сверяем и закрашиваем ячейки.

        For Each color1 In Sheets("Календарь").UsedRange.Cells
            If .exists(color1.Value) Then '-проверяем условие существования на листе "Calendar" точно таких же дат, как есть на листе "Action Plan"
                arr = Split(.Item(color1.Value), "|")
                color1.Interior.Color = arr(0) '-назначаем цвет фона ячейки
                color1.Interior.Pattern = arr(1) '-назначаем формат штриховки ячейки
                color1.Interior.PatternColor = arr(2) '-назначаем цвет штриховки ячейки
            End If
        Next
    End With
End Sub


Так вот, прошу вас, форумчане проверить мои комментарии, все ли команды я правильно расшифровываю?
Кроме этого я не могу логически для себя понять вот эту строку:
Код
arr = Split(.Item(color1.Value), "|")

Т.е. зачем мы переменной arr присваиваем что-то? И соответственно потом в дальнейшем используем эту переменную arr в тем строках, где назначаем цвет ячейки и т.д. (не понимаю команду split(.Item(color1.Value), "|"))
Причем в следующих строках с использованием arr мы в скобках пишем разные цифры (0) (1) (2), зачем?

P.S. Простите за дилетантизм, и прошу хотя бы ссылку на простейшее описание (хелп от VBA и прочие официальные описания не дали мне ответ, а простые формы описания не нашел).

Заранее спасибо большое за ответ (-ы).
Владимир.
Макрос: найти одинаковые значения и отметить их цветом
 
Ура-а-а! Работает!
Спасибо вам, Hugo!

Вот немного изменил код, добавил также цвет линий штриховки:
Код
Private Sub CommandButton1_Click()
    Dim color1 As Range, arr

    With CreateObject("scripting.dictionary")
        For Each color1 In Sheets("Список").[a1].CurrentRegion.Columns(1).Cells
            .Item(color1.Value) = color1.Interior.Color & "|" & color1.Interior.Pattern & "|" & color1.Interior.PatternColor
        Next

        Sheets("Календарь").UsedRange.Cells.Interior.Color = xlNone

        For Each color1 In Sheets("Календарь").UsedRange.Cells
            If .exists(color1.Value) Then
                arr = Split(.Item(color1.Value), "|")
                color1.Interior.Color = arr(0)
                color1.Interior.Pattern = arr(1)
                color1.Interior.PatternColor = arr(2)
            End If
        Next
    End With
End Sub
Макрос: найти одинаковые значения и отметить их цветом
 
Hugo, спасибо за помощь. Проверил, к сожалению - не работает.
Вот ошибка:
Макрос: найти одинаковые значения и отметить их цветом
 
Уважаемые форумчане, вот что я получил на данный момент:
Задача: скопировать цвет ячейки (если ячейка цветная) и скопировать штриховку (если есть штриховка), и затем вставить соответствующий вид в нужную ячейку.

Кодов у меня есть два:
1. Код для копирования цвета заливки ячейки
Код
Private Sub CommandButton1_Click()
    Dim color1 As Range

    With CreateObject("scripting.dictionary")
        For Each color1 In Sheets("Список").[a1].CurrentRegion.Columns(1).Cells
            .Item(color1.Value) = color1.Interior.Color
        Next
             
        Sheets("Календарь").UsedRange.Cells.Interior.Color = xlNone

        For Each color1 In Sheets("Календарь").UsedRange.Cells
            If .exists(color1.Value) Then color1.Interior.Color = .Item(color1.Value)
        Next
    End With
End Sub


2. Код для копирования штриховки ячейки
Код
Private Sub CommandButton1_Click()
    Dim pattern1 As Range

    With CreateObject("scripting.dictionary")
        For Each pattern1 In Sheets("Список").[a1].CurrentRegion.Columns(1).Cells
            .Item(pattern1.Value) = pattern1.Interior.Pattern
        Next
             
        Sheets("Календарь").UsedRange.Cells.Interior.Color = xlNone

        For Each pattern1 In Sheets("Календарь").UsedRange.Cells
            If .exists(pattern1.Value) Then pattern1.Interior.Pattern = .Item(pattern1.Value)
        Next
    End With
End Sub


И эти оба кода работают по отдельности. Т.е. таким образом Pattern отвечает за штриховку, Color за цвет заливки ячейки, а PatternColor (я его пока не применял, но код пишется точно также как два предыдущих) - за цвет штриховки.

Мой вопрос к вам: как в одном коде объединить все эти три показателя Color, Pattern и PatternColor?
Макрос: найти одинаковые значения и отметить их цветом
 
Уважаемый, Hugo!
Прошу вашей помощи. Сам не могу прописать копирование формата. Вроде с цветом все нормально, а вот как штриховку цветную скопировать - не могу найти.
Заранее спасибо за помощь.
Макрос: найти одинаковые значения и отметить их цветом
 
Уважаемые форумчане,

Стоит еще одна задача, а именно в списке есть ячейки, которые заштрихованы цветной штриховкой (т.е. есть выбран определенный цвет Pattern Color и тип штриховки Pattern Style).

И по аналогии с предыдущим копированием цвета ячейки нужно также скопировать штриховку.

Понимаю, что в код нужно прописывать или Pattern или PatternColor, но пока код не могу рабочий написать.
Помогите пожалуйста!
Заранее огромное спасибо!
Макрос: найти одинаковые значения и отметить их цветом
 
Вот еще внес некоторые изменения, а именно задача была такая, что в списке некоторые даты могли меняться, поэтому календарь соответственно нужно было перестаривать, поэтому я в код добавил строку обнуления всех цветов в календаре. Ниже мой код:

Код
Private Sub CommandButton1_Click()
 Dim cc As Range
 With CreateObject("scripting.dictionary" ;) 
 For Each cc In Sheets("Список" ;) .[a1].CurrentRegion.Columns(1).Cells
 .Item(cc.Value) = cc.Interior.Color
 Next
 Sheets("Календарь" ;) .UsedRange.Cells.Interior.Color = xlNone '-обнуляем все цвета в календаре
 For Each cc In Sheets("Календарь" ;) .UsedRange.Cells
 If .exists(cc.Value) Then cc.Interior.Color = .Item(cc.Value)
 Next
 End With
End Sub


Все ли правильно я сделал?
Макрос: найти одинаковые значения и отметить их цветом
 
Цитата
Hugo пишет:
Есть косяк с заголовком - но это можно подчистить в конце, или добавить доп.проверку в код. Или так и оставить

Hugo, спасибо за код, действительно очень просто. По поводу заголовка - подправлю, там просто на данный момент стоит дата, поэтому я поменяю на текст и все дела.
Еще раз спасибо. Работает!
Макрос: найти одинаковые значения и отметить их цветом
 
Уважаемые знатоки-форумчане,

У меня такая же задача, но несколько другое условие, а именно нужно сравнить два массива данных
- первый массив - это список действий с датами, причем ячейка с каждым действием имеет свой цвет;
- второй массив - это календарь на год;

Задача: сравнить два листа, и найти все одинаковые значения и на листе с календарем отметить в в календаре ту дату тем цветом, какой установлен на листе со списком.

Прилагаю исходный файл:

P.S. Заранее прошу сильно не ругать, тем про сравнение двух массивов очень предостаточно тут на форуме, но найти для себя решение - так и не осилил, поэтому и прошу вашей помощи.
Заранее спасибо огромное!
Страницы: 1
Наверх