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"))

请注意，在单行中填充许多列仅需要将数组传递到范围内，但要在单列中填充许多行，则必须对数组进行转置。

请阅读How to avoid using Select in Excel VBA。

为某些单元格编码颜色

1 个答案: