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

Вход

Регистрация

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

 

= Мир MS Excel/Применение Цветовых шкал сразу на весь диапазон - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Применение Цветовых шкал сразу на весь диапазон (Условное Форматирование/Conditional Formattings)
Применение Цветовых шкал сразу на весь диапазон
nechehov Дата: Четверг, 14.12.2017, 16:31 | Сообщение № 1
Группа: Пользователи
Ранг: Участник
Сообщений: 81
Репутация: 0 ±
Замечаний: 0% ±

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

Когда просто выделяешь диапазон значений и используешь Цветовые шкалы, то Excel выбирает из всего диапазона максимальное значение, закрашивает его тёмно-зеленым и уже далее светло-зел, желтый, красный. Но выглядит это все почти однотонно.

Мне нужно, чтобы форматирование применилось на каждую строку отдельно, но как сделать так, чтобы протянуть это форматирование на весь диапазон значений сразу, а не выбирать строки по одной и закрашивать их?
К сообщению приложен файл: 3708874.xlsx (46.3 Kb)
 
Ответить
СообщениеДобрый день!

Когда просто выделяешь диапазон значений и используешь Цветовые шкалы, то Excel выбирает из всего диапазона максимальное значение, закрашивает его тёмно-зеленым и уже далее светло-зел, желтый, красный. Но выглядит это все почти однотонно.

Мне нужно, чтобы форматирование применилось на каждую строку отдельно, но как сделать так, чтобы протянуть это форматирование на весь диапазон значений сразу, а не выбирать строки по одной и закрашивать их?
Автор - nechehov
Дата добавления - 14.12.2017 в 16:31
SLAVICK Дата: Четверг, 14.12.2017, 17:21 | Сообщение № 2
Группа: Модераторы
Ранг: Старожил
Сообщений: 2290
Репутация: 766 ±
Замечаний: 0% ±

2019
Цитата nechehov, 14.12.2017 в 16:31, в сообщении № 1 ()
применилось на каждую строку отдельно,

Когда-то давно также возникла такая проблема. Написал макрос - сейчас использую:
[vba]
Код
Sub Цветовые_шкалы()
Dim t As String
Dim c As Long
Dim ran As Range
Dim ra As Range
Dim col1()
Dim col2()
Dim col3()

col1 = Array(7039480, 8109667, 7039480, 8109667, 7039480, 8109667, 10285055, 7039480, 8109667, 7039480, 16776444, 13011546)
col2 = Array(8711167, 8711167, 16776444, 16776444, 16776444, 10285055, 8109667, 16776444, 16776444, 16776444, 7039480, 16776444)
col3 = Array(8109667, 7039480, 8109667, 7039480, 13011546, 0, 0, 0, 0, 0, 0, 7039480)
Set ran = Selection
t = InputBox("1 = построчно" & vbCr & "2 = по столбцам" & vbCr & "3= весь диапазон", "применить для", 1)
If t = "" Then Exit Sub
c = InputBox("Вариант расцветки", , 0)
If t = "3" Then Call цветШкала(ran, col1(c) * 1, col2(c) * 1, col3(c) * 1): Exit Sub
If t = "1" Then
    For Each ra In ran.Rows
    Call цветШкала(ra, col1(c) * 1, col2(c) * 1, col3(c) * 1)
    Next
    Exit Sub
End If
If t = "2" Then
    For Each ra In ran.Columns
    Call цветШкала(ra, col1(c) * 1, col2(c) * 1, col3(c) * 1)
    Next
    Exit Sub
End If
End Sub

Private Sub цветШкала(r As Range, col1#, col2#, col3#)
With r
    .FormatConditions.AddColorScale ColorScaleType:=3
    .FormatConditions(.FormatConditions.Count).SetFirstPriority
    With .FormatConditions(1)
        .ColorScaleCriteria(1).Type = xlConditionValueLowestValue
        .ColorScaleCriteria(1).FormatColor.Color = col1

        .ColorScaleCriteria(2).Type = xlConditionValuePercentile
        .ColorScaleCriteria(2).Value = 50
        .ColorScaleCriteria(2).FormatColor.Color = col2
        
        If col3 > 0 Then .ColorScaleCriteria(3).Type = xlConditionValueHighestValue: .ColorScaleCriteria(3).FormatColor.Color = col3
    End With
End With
End Sub

[/vba]
Ничего не правил в нем - лениво. Просто выдрал из своей книги макросов :)
К сообщению приложен файл: 3708874.xlsm (56.3 Kb)

Иногда все проще чем кажется с первого взгляда.
 
Ответить
Сообщение
Цитата nechehov, 14.12.2017 в 16:31, в сообщении № 1 ()
применилось на каждую строку отдельно,

Когда-то давно также возникла такая проблема. Написал макрос - сейчас использую:
[vba]
Код
Sub Цветовые_шкалы()
Dim t As String
Dim c As Long
Dim ran As Range
Dim ra As Range
Dim col1()
Dim col2()
Dim col3()

col1 = Array(7039480, 8109667, 7039480, 8109667, 7039480, 8109667, 10285055, 7039480, 8109667, 7039480, 16776444, 13011546)
col2 = Array(8711167, 8711167, 16776444, 16776444, 16776444, 10285055, 8109667, 16776444, 16776444, 16776444, 7039480, 16776444)
col3 = Array(8109667, 7039480, 8109667, 7039480, 13011546, 0, 0, 0, 0, 0, 0, 7039480)
Set ran = Selection
t = InputBox("1 = построчно" & vbCr & "2 = по столбцам" & vbCr & "3= весь диапазон", "применить для", 1)
If t = "" Then Exit Sub
c = InputBox("Вариант расцветки", , 0)
If t = "3" Then Call цветШкала(ran, col1(c) * 1, col2(c) * 1, col3(c) * 1): Exit Sub
If t = "1" Then
    For Each ra In ran.Rows
    Call цветШкала(ra, col1(c) * 1, col2(c) * 1, col3(c) * 1)
    Next
    Exit Sub
End If
If t = "2" Then
    For Each ra In ran.Columns
    Call цветШкала(ra, col1(c) * 1, col2(c) * 1, col3(c) * 1)
    Next
    Exit Sub
End If
End Sub

Private Sub цветШкала(r As Range, col1#, col2#, col3#)
With r
    .FormatConditions.AddColorScale ColorScaleType:=3
    .FormatConditions(.FormatConditions.Count).SetFirstPriority
    With .FormatConditions(1)
        .ColorScaleCriteria(1).Type = xlConditionValueLowestValue
        .ColorScaleCriteria(1).FormatColor.Color = col1

        .ColorScaleCriteria(2).Type = xlConditionValuePercentile
        .ColorScaleCriteria(2).Value = 50
        .ColorScaleCriteria(2).FormatColor.Color = col2
        
        If col3 > 0 Then .ColorScaleCriteria(3).Type = xlConditionValueHighestValue: .ColorScaleCriteria(3).FormatColor.Color = col3
    End With
End With
End Sub

[/vba]
Ничего не правил в нем - лениво. Просто выдрал из своей книги макросов :)
Автор - SLAVICK
Дата добавления - 14.12.2017 в 17:21
stalber Дата: Пятница, 23.02.2018, 01:14 | Сообщение № 3
Группа: Проверенные
Ранг: Обитатель
Сообщений: 369
Репутация: 7 ±
Замечаний: 40% ±

Excel 2021
Помогите пожалуйста, мне нужно использовать не цветные шкалы, а гистограммы. С гистограммами подобная проблема. Не найдётся случаем макроса на гистограммы?
 
Ответить
СообщениеПомогите пожалуйста, мне нужно использовать не цветные шкалы, а гистограммы. С гистограммами подобная проблема. Не найдётся случаем макроса на гистограммы?
Автор - stalber
Дата добавления - 23.02.2018 в 01:14
Pelena Дата: Пятница, 23.02.2018, 09:57 | Сообщение № 4
Группа: Админы
Ранг: Местный житель
Сообщений: 19404
Репутация: 4555 ±
Замечаний: ±

Excel 365 & Mac Excel
Цитата awaddwaawddw, 23.02.2018 в 01:14, в сообщении № 3 ()
не цветные шкалы, а гистограммы

Тогда какое отношение Ваш вопрос имеет к данной теме? Создайте новую

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
Сообщение
Цитата awaddwaawddw, 23.02.2018 в 01:14, в сообщении № 3 ()
не цветные шкалы, а гистограммы

Тогда какое отношение Ваш вопрос имеет к данной теме? Создайте новую
Автор - Pelena
Дата добавления - 23.02.2018 в 09:57
Oh_Nick Дата: Среда, 10.01.2024, 16:20 | Сообщение № 5
Группа: Проверенные
Ранг: Обитатель
Сообщений: 445
Репутация: 8 ±
Замечаний: 20% ±

Excel 2019
Всем доброго времени суток!

Очень понравился код выше. А можно ли немного его скорректировать, чтобы можно было выбрать не весь диапазон, а колонки с шагом? Пример приложил.
К сообщению приложен файл: konkurentnyj_list.xlsm (24.0 Kb)
 
Ответить
СообщениеВсем доброго времени суток!

Очень понравился код выше. А можно ли немного его скорректировать, чтобы можно было выбрать не весь диапазон, а колонки с шагом? Пример приложил.
Автор - Oh_Nick
Дата добавления - 10.01.2024 в 16:20
Oh_Nick Дата: Среда, 10.01.2024, 23:05 | Сообщение № 6
Группа: Проверенные
Ранг: Обитатель
Сообщений: 445
Репутация: 8 ±
Замечаний: 20% ±

Excel 2019
через макрекодер получилось сделать вот так,но опять же это для определенных диапазонов. а можно ли это как то автоматизировать?

[vba]
Код
Sub ApplyColorScale(rng As Range)
    rng.Select
    
    Selection.FormatConditions.AddColorScale ColorScaleType:=3
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    
    With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor
        .Color = 8109667
        .TintAndShade = 0
    End With
    
    Selection.FormatConditions(1).ColorScaleCriteria(2).Type = xlConditionValuePercentile
    Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50
    
    With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor
        .Color = 8711167
        .TintAndShade = 0
    End With
    
    Selection.FormatConditions(1).ColorScaleCriteria(3).Type = xlConditionValueHighestValue
    
    With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor
        .Color = 7039480
        .TintAndShade = 0
    End With
End Sub

Sub MainMacro()
    ApplyColorScale Range("G8,I8,K8,M8")
    ApplyColorScale Range("G9,I9,K9,M9")
    ApplyColorScale Range("G10,I10,K10,M10")
    ApplyColorScale Range("G11,I11,K11,M11")
End Sub
[/vba]
 
Ответить
Сообщениечерез макрекодер получилось сделать вот так,но опять же это для определенных диапазонов. а можно ли это как то автоматизировать?

[vba]
Код
Sub ApplyColorScale(rng As Range)
    rng.Select
    
    Selection.FormatConditions.AddColorScale ColorScaleType:=3
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    
    With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor
        .Color = 8109667
        .TintAndShade = 0
    End With
    
    Selection.FormatConditions(1).ColorScaleCriteria(2).Type = xlConditionValuePercentile
    Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50
    
    With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor
        .Color = 8711167
        .TintAndShade = 0
    End With
    
    Selection.FormatConditions(1).ColorScaleCriteria(3).Type = xlConditionValueHighestValue
    
    With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor
        .Color = 7039480
        .TintAndShade = 0
    End With
End Sub

Sub MainMacro()
    ApplyColorScale Range("G8,I8,K8,M8")
    ApplyColorScale Range("G9,I9,K9,M9")
    ApplyColorScale Range("G10,I10,K10,M10")
    ApplyColorScale Range("G11,I11,K11,M11")
End Sub
[/vba]
Автор - Oh_Nick
Дата добавления - 10.01.2024 в 23:05
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Применение Цветовых шкал сразу на весь диапазон (Условное Форматирование/Conditional Formattings)
  • Страница 1 из 1
  • 1
Поиск:

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