Макрос расстановки цветов - как аналог УФ

Страница 1 из 1 1
Модератор форума: китин, _Boroda_, DrMini

Макрос расстановки цветов - как аналог УФ (Макросы/Sub)

mv6677

Дата: Воскресенье, 06.05.2018, 20:38 | Сообщение № 1

Группа: Пользователи

Ранг: Участник

Сообщений: 71

Репутация: 3 ±

Замечаний: 0% ±

Excel 2013

Здравствуйте.
Подскажите с решением вопроса.

Есть такой макрос вба, который в заданном диапазоне Z6:AP28 - проводит что-то вроде условного форматирования.
Если видит 1, то ставит зеленый цвет. А если видит 0 - то ставит белый цвет шрифта.
Но он работает с простым цветом.

Скажите - как научить этот макрос аналогичным образом провести такую же расстановку цветов - в диапазоне E6:R28, где нужна сложная заливка ?
(То есть там - белый цвет - градиентно переходит в желтый, или белый в серый.)

К сообщению приложен файл: -2-.xls (48.0 Kb)

Ответить

Апострофф

Дата: Воскресенье, 06.05.2018, 21:29 | Сообщение № 2

Группа: Проверенные

Ранг: Обитатель

Сообщений: 467

Репутация: 129 ±

Замечаний: 0% ±

Excel 1997

mv6677, вот вам пример сложной заливки для одного значения-
[vba]

Код

Sub Макрос2()
Dim c As Range
For Each c In [e6:r28]
    If c = 1 Then
      With c.Interior
          .Pattern = xlPatternLinearGradient
          .Gradient.Degree = 45
          With .Gradient.ColorStops
              .Clear
              .Add(0).Color = vbWhite
              .Add(1).Color = 65535
          End With
      End With
    End If
Next
End Sub

[/vba]

Сообщение отредактировал Апострофф - Воскресенье, 06.05.2018, 21:43

Ответить

mv6677

Дата: Воскресенье, 06.05.2018, 22:11 | Сообщение № 3

Группа: Пользователи

Ранг: Участник

Сообщений: 71

Репутация: 3 ±

Замечаний: 0% ±

Excel 2013

Апострофф, подскажите - как две проверки в один код совместить, чтобы не писать два раза For Each c In [E6:R28] ?

[vba]

Код

Sub Макрос4()
Dim c As Range
For Each c In [E6:R28]
    If c = 0.5 Then
    With c.Interior
        .Pattern = xlPatternLinearGradient
        .Gradient.Degree = 45
        With .Gradient.ColorStops
            .Clear
            .Add(0).Color = vbWhite
            .Add(1).ThemeColor = xlThemeColorDark2
            .Add(1).TintAndShade = -0.250984221930601
        End With
    End With
    End If
Next

For Each c In [E6:R28]
    If c = 1 Then
    With c.Interior
        .Pattern = xlPatternLinearGradient
        .Gradient.Degree = 45
        With .Gradient.ColorStops
            .Clear
            .Add(0).Color = vbWhite
            .Add(1).Color = 65535
        End With
    End With
    End If
Next

End Sub

[/vba]