Кодирование определенных клеток цветом

Question

Как мне написать что-то, чтобы сказать: если общая сумма меньше 1000 долларов (E11: E28), то она станет красной? Кроме того, есть ли способ очистить этот VBA, чтобы он не был таким длинным?

Это проект, который я хочу научить своих учеников как способ составления базового бюджета.

Вот мой текущий код:

Sub ClassroomSupplies()

Range("A7").Select
ActiveCell.FormulaR1C1 = "Week of July 2-6, 2018"
Range("A10").Select
Columns("B:B").ColumnWidth = 9.57
Range("A8:B8").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Range("A10").Select
ActiveCell.FormulaR1C1 = "AMOUNT"
Range("B10").Select
ActiveCell.FormulaR1C1 = "SALES"
Range("C10").Select
ActiveCell.FormulaR1C1 = "PRICE PER UNIT"
Range("D10").Select
ActiveCell.FormulaR1C1 = "TAX"
Range("E10").Select
ActiveCell.FormulaR1C1 = "TOTAL"
Range("A11").Select
ActiveCell.FormulaR1C1 = "Calculators"
Range("A12").Select
ActiveCell.FormulaR1C1 = "Pencils"
Range("A13").Select
ActiveCell.FormulaR1C1 = "Loose Leaf Paper"
Range("A14").Select
ActiveCell.FormulaR1C1 = "Balloons"
Range("A15").Select
ActiveCell.FormulaR1C1 = "Mirrors"
Range("A16").Select
ActiveCell.FormulaR1C1 = "Axles"
Range("A17").Select
ActiveCell.FormulaR1C1 = "Wheels"
Range("A18").Select
ActiveCell.FormulaR1C1 = "Masking Tape"
Range("A19").Select
ActiveCell.FormulaR1C1 = "Electrical Tape"
Range("A20").Select
ActiveCell.FormulaR1C1 = "Mini Blocks"
Range("A21").Select
ActiveCell.FormulaR1C1 = "Tongue Depressors"
Range("A22").Select
ActiveCell.FormulaR1C1 = "Slinkys"
Range("A23").Select
ActiveCell.FormulaR1C1 = "Beakers"
Range("A24").Select
ActiveCell.FormulaR1C1 = "Test Tubes"
Range("A25").Select
ActiveCell.FormulaR1C1 = "Colored Pencils"
Range("A26").Select
ActiveCell.FormulaR1C1 = "Lenses"
Range("A27").Select
ActiveCell.FormulaR1C1 = "Newspapers"
Range("A28").Select
ActiveCell.FormulaR1C1 = "Cardboard"
Range("B11").Select
ActiveCell.FormulaR1C1 = "10392"
Range("B12").Select
ActiveCell.FormulaR1C1 = "10788"
Range("B13").Select
ActiveCell.FormulaR1C1 = "15588"
Range("B14").Select
ActiveCell.FormulaR1C1 = "1188"
Range("B15").Select
ActiveCell.FormulaR1C1 = "5970"
Range("B16").Select
ActiveCell.FormulaR1C1 = "8970"
Range("B17").Select
ActiveCell.FormulaR1C1 = "7980"
Range("B18").Select
ActiveCell.FormulaR1C1 = "5990"
Range("B19").Select
ActiveCell.FormulaR1C1 = "2970"
Range("B20").Select
ActiveCell.FormulaR1C1 = "4788"
Range("B21").Select
ActiveCell.FormulaR1C1 = "3192"
Range("B22").Select
ActiveCell.FormulaR1C1 = "6487"
Range("B23").Select
ActiveCell.FormulaR1C1 = "490"
Range("B24").Select
ActiveCell.FormulaR1C1 = "490"
Range("B25").Select
ActiveCell.FormulaR1C1 = "15684"
Range("B26").Select
ActiveCell.FormulaR1C1 = "80"
Range("B27").Select
ActiveCell.FormulaR1C1 = "100"
Range("B28").Select
ActiveCell.FormulaR1C1 = "95"
Range("B29").Select
Range("C11:C28").Select
Selection.Style = "Currency"
Range("D11").Select
ActiveCell.FormulaR1C1 = "=SUM((RC[-2]*RC[-1])*0.0625)"
Range("D11").Select
Selection.AutoFill Destination:=Range("D11:D28"), Type:=xlFillDefault
Range("D11:D28").Select
Selection.Style = "Currency"
Range("E11").Select
ActiveCell.FormulaR1C1 = "=SUM((RC[-3]*RC[-2])+RC[-1])"
Range("E11").Select
Selection.AutoFill Destination:=Range("E11:E28"), Type:=xlFillDefault
Range("E11:E28").Select
Range("E31").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-20]C:R[-3]C)"       
ActiveCell.FormulaR1C1 = "=SUM(R[-20]C:R[-3]C)"
Range("E34").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(R[-3]C/5)"
Range("E35").Select
End Sub

Любая помощь будет принята с благодарностью.

Спасибо!

Answer 1

Попробуйте,

'this to set a conditional formatting rule on E11:E28
 with range("E11:E28")
     .FormatConditions.Delete
     With .FormatConditions.Add(Type:=xlExpression, Formula1:="=and(len($e11), $e11<1000)")
         .Interior.Color = vbred
     End With
 end with

'this should get you started cleaning up the text labels
Range("A10:E10") = array("AMOUNT","SALES","PRICE PER UNIT","TAX","TOTAL")

Range("A11:A28") = application.transpose(array("Calculators","Pencils","Loose Leaf Paper", _
                               "Balloons","Mirrors","Axles","Wheels","Masking Tape", _
                               "Electrical Tape","Mini Blocks","Tongue Depressors", _
                               "Slinkys","Beakers","Test Tubes","Colored Pencils", _
                               "Lenses","Newspapers","Cardboard"))

Обратите внимание, что заполнение ряда столбцов в одной строке требует только передачи массива в диапазон, но для заполнения количества строк в одном столбце необходимо транспонировать массив.

Пожалуйста, прочитайте Как избежать использования Select в Excel VBA .