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

 

= Мир MS Excel/Динамический диапазон при условном форматировании - Мир MS Excel

  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_, DrMini  
Динамический диапазон при условном форматировании
redgreendevil88 Дата: Четверг, 23.12.2021, 13:03 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 1
Репутация: 0 ±
Замечаний: 20% ±

Добрый день, записал макрос, в котором от активной ячейки спускаюсь на 4 строки ниже и применяю условное форматирование для среднего значения по выбранному диапазону увеличенному на 5% ячейки окрашиваются в зелёный, для среднего по диапазону уменьшенному на 5% в красный, далее открыл макрос и отредактировал формулу в vba. Она ниже:

Sub Критический()
'
' Критический Макрос
' ±5%
'
' Сочетание клавиш: Ctrl+й
'
Dim diaP As Variant
Set diaP = ActiveCell.Offset(4, 0).Range("A1:K1")
ActiveCell.Offset(4, 0).Range("A1:K1").Select
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual _
, Formula1:="WorkSheet.Average(diaP)*1,05"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0.799981688894314
End With
Selection.FormatConditions(1).StopIfTrue = False
ActiveCell.Range("A1:K1").Select
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLessEqual, _
Formula1:="WorkSheet.Average(diaP)*0,95"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent2
.TintAndShade = 0.799981688894314
End With
Selection.FormatConditions(1).StopIfTrue = False
End Sub



Вопрос в переменной: диапазон должен быть динамическим - меняться строка от активной ячейки(сейчас Range("A1:K1")), всю голову сломал


Сообщение отредактировал Serge_007 - Четверг, 23.12.2021, 13:18
 
Ответить
СообщениеДобрый день, записал макрос, в котором от активной ячейки спускаюсь на 4 строки ниже и применяю условное форматирование для среднего значения по выбранному диапазону увеличенному на 5% ячейки окрашиваются в зелёный, для среднего по диапазону уменьшенному на 5% в красный, далее открыл макрос и отредактировал формулу в vba. Она ниже:
[vba]
Sub Критический()'' Критический Макрос' ±5%'' Сочетание клавиш: Ctrl+й'Dim diaP As VariantSet diaP = ActiveCell.Offset(4; 0).Range("A1:K1")ActiveCell.Offset(4; 0).Range("A1:K1").SelectSelection.FormatConditions.Add Type:=xlCellValue; Operator:=xlGreaterEqual _; Formula1:="WorkSheet.Average(diaP)*1,05"Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriorityWith Selection.FormatConditions(1).Interior.PatternColorIndex = xlAutomatic.ThemeColor = xlThemeColorAccent3.TintAndShade = 0,799981688894314End WithSelection.FormatConditions(1).StopIfТrue = FalseActiveCell.Range("A1:K1").SelectSelection.FormatConditions.Add Type:=xlCellValue; Operator:=xlLessEqual; _Formula1:="WorkSheet.Average(diaP)*0,95"Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriorityWith Selection.FormatConditions(1).Interior.PatternColorIndex = xlAutomatic.ThemeColor = xlThemeColorAccent2.TintAndShade = 0,799981688894314End WithSelection.FormatConditions(1).StopIfТrue = FalseEnd Sub
[/vba]

Вопрос в переменной: диапазон должен быть динамическим - меняться строка от активной ячейки(сейчас Range("A1:K1")), всю голову сломал

Автор - redgreendevil88
Дата добавления - 23.12.2021 в 13:03
boa Дата: Четверг, 23.12.2021, 18:47 | Сообщение № 2
Группа: Друзья
Ранг: Ветеран
Сообщений: 563
Репутация: 167 ±
Замечаний: 0% ±

365
Здравствуйте, redgreendevil88,

Sub Критический()
'
' Критический Макрос
' ±5%
'
' Сочетание клавиш: Ctrl+й
'
Dim iRow&: iRow = ActiveCell.Row

With Application.ActiveSheet
    With .Range(.Cells(iRow, 1), .Cells(iRow, 11))
    .FormatConditions.Add Type:=xlCellValue, Operator:=xlLessEqual, Formula1:="WorkSheet.Average(diaP)*0,95"
    With .FormatConditions(.FormatConditions.Count)
        With .Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent2
        .TintAndShade = 0.8
        End With  ' .Interior
    .StopIfTrue = False
    End With  ' .FormatConditions(.FormatConditions.Count)
    
    With .Offset(4)
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual, Formula1:="WorkSheet.Average(diaP)*1,05"
        With .FormatConditions(.FormatConditions.Count)
        With .Interior
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent3
            .TintAndShade = 0.8
        End With  '.Interior
        .StopIfTrue = False
        End With  ' .FormatConditions(.FormatConditions.Count)
    End With  ' .Offset(4)
    End With  ' .Range(.Cells(iRow, 1), .Cells(iRow, 11))
End With  ' Application.ActiveSheet
End Sub



 
Ответить
СообщениеЗдравствуйте, redgreendevil88,

[vba]
Sub Критический()'' Критический Макрос' ±5%'' Сочетание клавиш: Ctrl+й'  Dim iRow&: iRow = ActiveCell.Row    With Application.ActiveSheet    With .Range(.Cells(iRow; 1); .Cells(iRow; 11))      .FormatConditions.Add Type:=xlCellValue; Operator:=xlLessEqual; Formula1:="WorkSheet.Average(diaP)*0,95"      With .FormatConditions(.FormatConditions.Count)        With .Interior          .PatternColorIndex = xlAutomatic          .ThemeColor = xlThemeColorAccent2          .TintAndShade = 0,8        End With  ' .Interior      .StopIfТrue = False      End With  ' .FormatConditions(.FormatConditions.Count)          With .Offset(4)        .FormatConditions.Add Type:=xlCellValue; Operator:=xlGreaterEqual; Formula1:="WorkSheet.Average(diaP)*1,05"         With .FormatConditions(.FormatConditions.Count)          With .Interior            .PatternColorIndex = xlAutomatic            .ThemeColor = xlThemeColorAccent3            .TintAndShade = 0,8          End With  '.Interior        .StopIfТrue = False        End With  ' .FormatConditions(.FormatConditions.Count)      End With  ' .Offset(4)    End With  ' .Range(.Cells(iRow; 1); .Cells(iRow; 11))  End With  ' Application.ActiveSheetEnd Sub
[/vba]

Автор - boa
Дата добавления - 23.12.2021 в 18:47
  • Страница 1 из 1
  • 1
Поиск:

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