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

Вход

Регистрация

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

 

= Мир MS Excel/Макрос по цветам - Мир MS Excel

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

Excel 2010
Добрый день!

Есть файл в котором подрядчик цветами обозначает версии и распределяет их по месяцу.
Цель с помощью макроса в аналогичную таблицу справа вместо заливки ячейки. прописать название версии.

Как я понимаю, в этом случае необходимо использовать цикл по столбцу с версиями и по таблице где подрядчик показывает график.

Подскажите пожалуйста, можно ли как то сослаться с помощью макроса на цвет ячейки из одной таблицы, найти этот цвет в другой таблице и соотнеся данные внести их в третью таблицу?

Заранее спасибо)
К сообщению приложен файл: 3105929.xlsx(26.5 Kb)
 
Ответить
СообщениеДобрый день!

Есть файл в котором подрядчик цветами обозначает версии и распределяет их по месяцу.
Цель с помощью макроса в аналогичную таблицу справа вместо заливки ячейки. прописать название версии.

Как я понимаю, в этом случае необходимо использовать цикл по столбцу с версиями и по таблице где подрядчик показывает график.

Подскажите пожалуйста, можно ли как то сослаться с помощью макроса на цвет ячейки из одной таблицы, найти этот цвет в другой таблице и соотнеся данные внести их в третью таблицу?

Заранее спасибо)

Автор - eboryaeva
Дата добавления - 09.04.2019 в 14:22
excelius Дата: Вторник, 09.04.2019, 15:14 | Сообщение № 2
Группа: Пользователи
Ранг: Прохожий
Сообщений: 9
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
Цвет ячейки [vba]
Код
Range.Interior.Color
[/vba]
 
Ответить
СообщениеЦвет ячейки [vba]
Код
Range.Interior.Color
[/vba]

Автор - excelius
Дата добавления - 09.04.2019 в 15:14
skais Дата: Вторник, 09.04.2019, 15:18 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 164
Репутация: 21 ±
Замечаний: 60% ±

Excel 2010
Решение
[vba]
Код
Sub Button1_Click()
    Application.ScreenUpdating = False
    For Z = 6 To Cells(Rows.Count, "A").End(xlUp).Row
        For i = 1 To 30
            For j = 2 To Cells(Rows.Count, "AP").End(xlUp).Row
                If Cells(Z, i).Interior.Pattern = xlPatternRectangularGradient Or Cells(Z, i).Interior.Pattern = xlPatternLinearGradient Then
                    If Cells(Z, i).Interior.Gradient.ColorStops(1).Color = Cells(j, "AK").Interior.Gradient.ColorStops(1).Color _
                    And Cells(Z, i).Interior.Gradient.ColorStops(2).Color = Cells(j, "AK").Interior.Gradient.ColorStops(2).Color Then
                        Cells(Z, i + 50) = Cells(j, "AP").Value
                        Exit For
                    End If
                End If
            Next
        Next
    Next
    Application.ScreenUpdating = True
End Sub
[/vba]
К сообщению приложен файл: 3105929.xlsm(38.5 Kb)


Сообщение отредактировал skais - Вторник, 09.04.2019, 15:22
 
Ответить
СообщениеРешение
[vba]
Код
Sub Button1_Click()
    Application.ScreenUpdating = False
    For Z = 6 To Cells(Rows.Count, "A").End(xlUp).Row
        For i = 1 To 30
            For j = 2 To Cells(Rows.Count, "AP").End(xlUp).Row
                If Cells(Z, i).Interior.Pattern = xlPatternRectangularGradient Or Cells(Z, i).Interior.Pattern = xlPatternLinearGradient Then
                    If Cells(Z, i).Interior.Gradient.ColorStops(1).Color = Cells(j, "AK").Interior.Gradient.ColorStops(1).Color _
                    And Cells(Z, i).Interior.Gradient.ColorStops(2).Color = Cells(j, "AK").Interior.Gradient.ColorStops(2).Color Then
                        Cells(Z, i + 50) = Cells(j, "AP").Value
                        Exit For
                    End If
                End If
            Next
        Next
    Next
    Application.ScreenUpdating = True
End Sub
[/vba]

Автор - skais
Дата добавления - 09.04.2019 в 15:18
eboryaeva Дата: Вторник, 09.04.2019, 15:46 | Сообщение № 4
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
skais, спасибо)

Как я понимаю, код работает только с градиентной заливкой, но подрядчик присылает иногда и простую заливку, и какую-то так сказать точечную. см вложение.
Подскажите пожалуйста, как обозначить такой тип заливки?
К сообщению приложен файл: Primer.xlsm(37.0 Kb)
 
Ответить
Сообщениеskais, спасибо)

Как я понимаю, код работает только с градиентной заливкой, но подрядчик присылает иногда и простую заливку, и какую-то так сказать точечную. см вложение.
Подскажите пожалуйста, как обозначить такой тип заливки?

Автор - eboryaeva
Дата добавления - 09.04.2019 в 15:46
skais Дата: Вторник, 09.04.2019, 16:40 | Сообщение № 5
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 164
Репутация: 21 ±
Замечаний: 60% ±

Excel 2010
[vba]
Код
Sub Button1_Click()
'.Range("BA6:CE59").ClearContents
    Application.ScreenUpdating = False
    For Z = 6 To Cells(Rows.Count, "A").End(xlUp).Row
        For i = 1 To 30
            For j = 2 To Cells(Rows.Count, "AP").End(xlUp).Row
                If Cells(Z, i).Interior.Pattern = Cells(j, "AK").Interior.Pattern Then
                    If (Cells(Z, i).Interior.Pattern = xlPatternRectangularGradient Or Cells(Z, i).Interior.Pattern = xlPatternLinearGradient) Then
                        If Cells(Z, i).Interior.Gradient.ColorStops(1).Color = Cells(j, "AK").Interior.Gradient.ColorStops(1).Color _
                        And Cells(Z, i).Interior.Gradient.ColorStops(2).Color = Cells(j, "AK").Interior.Gradient.ColorStops(2).Color Then
                            Cells(Z, i + 50) = Cells(j, "AP").Value
                            Exit For
                        End If
                    ElseIf Cells(Z, i).Interior.Color = Cells(j, "AK").Interior.Color And Cells(Z, i).Font.Color = Cells(j, "AK").Font.Color Then
                        Cells(Z, i + 50) = Cells(j, "AP").Value
                        Exit For
                    End If
                End If
            Next
        Next
    Next
    Application.ScreenUpdating = True
End Sub
[/vba]
К сообщению приложен файл: Primer-2-.xlsm(39.8 Kb)


Сообщение отредактировал skais - Вторник, 09.04.2019, 16:47
 
Ответить
Сообщение[vba]
Код
Sub Button1_Click()
'.Range("BA6:CE59").ClearContents
    Application.ScreenUpdating = False
    For Z = 6 To Cells(Rows.Count, "A").End(xlUp).Row
        For i = 1 To 30
            For j = 2 To Cells(Rows.Count, "AP").End(xlUp).Row
                If Cells(Z, i).Interior.Pattern = Cells(j, "AK").Interior.Pattern Then
                    If (Cells(Z, i).Interior.Pattern = xlPatternRectangularGradient Or Cells(Z, i).Interior.Pattern = xlPatternLinearGradient) Then
                        If Cells(Z, i).Interior.Gradient.ColorStops(1).Color = Cells(j, "AK").Interior.Gradient.ColorStops(1).Color _
                        And Cells(Z, i).Interior.Gradient.ColorStops(2).Color = Cells(j, "AK").Interior.Gradient.ColorStops(2).Color Then
                            Cells(Z, i + 50) = Cells(j, "AP").Value
                            Exit For
                        End If
                    ElseIf Cells(Z, i).Interior.Color = Cells(j, "AK").Interior.Color And Cells(Z, i).Font.Color = Cells(j, "AK").Font.Color Then
                        Cells(Z, i + 50) = Cells(j, "AP").Value
                        Exit For
                    End If
                End If
            Next
        Next
    Next
    Application.ScreenUpdating = True
End Sub
[/vba]

Автор - skais
Дата добавления - 09.04.2019 в 16:40
eboryaeva Дата: Понедельник, 15.04.2019, 16:27 | Сообщение № 6
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
skais, Большое спасибо за помощь, макрос работает просто прекрасно.

Подскажите пожалуйста, сможет ли он работать при условном форматировании ячеек по цветам, а не при ручном?
 
Ответить
Сообщениеskais, Большое спасибо за помощь, макрос работает просто прекрасно.

Подскажите пожалуйста, сможет ли он работать при условном форматировании ячеек по цветам, а не при ручном?

Автор - eboryaeva
Дата добавления - 15.04.2019 в 16:27
bmv98rus Дата: Понедельник, 15.04.2019, 17:34 | Сообщение № 7
Группа: Проверенные
Ранг: Старожил
Сообщений: 2135
Репутация: 360 ±
Замечаний: 20% ±

Excel 2013/2016
сможет ли он работать при условном форматировании ячеек по цветам
этот - нет, но коррекция вроде не большая , в случае если Excel 2010 и новее.


Замечательный медведь, процентов на 20.
 
Ответить
Сообщение
сможет ли он работать при условном форматировании ячеек по цветам
этот - нет, но коррекция вроде не большая , в случае если Excel 2010 и новее.

Автор - bmv98rus
Дата добавления - 15.04.2019 в 17:34
eboryaeva Дата: Понедельник, 15.04.2019, 18:41 | Сообщение № 8
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
bmv98rus, Подскажите пожалуйста. как можно считать формат ячейки при условном форматировании с помощью макроса? А то в интернете информации о том как создать уловное форматирование с помощью макроса полно. а о том как его считать найти не могу...
 
Ответить
Сообщениеbmv98rus, Подскажите пожалуйста. как можно считать формат ячейки при условном форматировании с помощью макроса? А то в интернете информации о том как создать уловное форматирование с помощью макроса полно. а о том как его считать найти не могу...

Автор - eboryaeva
Дата добавления - 15.04.2019 в 18:41
bmv98rus Дата: Понедельник, 15.04.2019, 19:20 | Сообщение № 9
Группа: Проверенные
Ранг: Старожил
Сообщений: 2135
Репутация: 360 ±
Замечаний: 20% ±

Excel 2013/2016
Range.DispalyFormat - это то что "видят глаза".


Замечательный медведь, процентов на 20.
 
Ответить
СообщениеRange.DispalyFormat - это то что "видят глаза".

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

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