Добрый день, записал макрос, в котором от активной ячейки спускаюсь на 4 строки ниже и применяю условное форматирование для среднего значения по выбранному диапазону увеличенному на 5% ячейки окрашиваются в зелёный, для среднего по диапазону уменьшенному на 5% в красный, далее открыл макрос и отредактировал формулу в vba. Она ниже: [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
[/vba]
Вопрос в переменной: диапазон должен быть динамическим - меняться строка от активной ячейки(сейчас Range("A1:K1")), всю голову сломал
Добрый день, записал макрос, в котором от активной ячейки спускаюсь на 4 строки ниже и применяю условное форматирование для среднего значения по выбранному диапазону увеличенному на 5% ячейки окрашиваются в зелёный, для среднего по диапазону уменьшенному на 5% в красный, далее открыл макрос и отредактировал формулу в vba. Она ниже: [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
[/vba]
Вопрос в переменной: диапазон должен быть динамическим - меняться строка от активной ячейки(сейчас Range("A1:K1")), всю голову сломалredgreendevil88
Сообщение отредактировал Serge_007 - Четверг, 23.12.2021, 13:18
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
[/vba]
Здравствуйте, 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 .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