根据原始单元格值，以不同的阴影着色多个单元格

我正在尝试创build一个将分割单元格值的macros，如果值大于7.5，则将单元格深绿色，然后继续为后续单元格着色为深绿色，例如2.25将为2个深绿色的单元格， .25浅绿色。 而且，如果要着色的单元的颜色含量是灰色的，则继续移动活动单元直到它在没有颜色的单元上。

For Each y In rng If Not IsEmpty(y) And y > 7.5 And y <> "" And IsNumeric(y) Then 'I am having trouble here y.Select With ActiveCell.Offset(0, i).Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorAccent3 .TintAndShade = -0.249977111117893 .PatternTintAndShade = 0 End With col = y.Value / 7.5 Count = Left(col, Len(col) - InStr(1, col, ".")) For i = 1 To Count Do While ActiveCell.Offset(0, i).TintAndShade = -0.149998474074526 i = i + 1: Count = Count + 1 Loop ActiveCell.Offset(0, i).Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorAccent3 .TintAndShade = -0.249977111117893 .PatternTintAndShade = 0 End With Next i Count = Right(col, Len(col) - InStr(1, col, ".")) If Count > 0 And Count < 25 Then ActiveCell.TintAndShade = -4.99893185216834E-02 ElseIf Count > 26 And Count < 50 Then ActiveCell.TintAndShade = 0.799981688894314 ElseIf Count > 75 And Count < 100 Then ActiveCell.TintAndShade = 0.599993896298105 End If Next y End If Next y 

macros是为了显示一周的工作量，灰色的单元格是周末，所以他们需要跳过。

Answer 1

当缩进你的代码时，你有一个If没有End If一个Next y 太多 （见下面的缩进代码）

 For Each y In rng ' ****** you are not closing this If ***** If Not IsEmpty(y) And y > 7.5 And y <> "" And IsNumeric(y) Then 'I am having trouble here y.Select With ActiveCell.Offset(0, i).Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorAccent3 .TintAndShade = -0.249977111117893 .PatternTintAndShade = 0 End With col = y.Value / 7.5 Count = Left(col, Len(col) - InStr(1, col, ".")) For i = 1 To Count Do While ActiveCell.Offset(0, i).TintAndShade = -0.149998474074526 i = i + 1: Count = Count + 1 Loop ActiveCell.Offset(0, i).Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorAccent3 .TintAndShade = -0.249977111117893 .PatternTintAndShade = 0 End With Next i Count = Right(col, Len(col) - InStr(1, col, ".")) If Count > 0 And Count < 25 Then ActiveCell.TintAndShade = -4.99893185216834E-02 ElseIf Count > 26 And Count < 50 Then ActiveCell.TintAndShade = 0.799981688894314 ElseIf Count > 75 And Count < 100 Then ActiveCell.TintAndShade = 0.599993896298105 End If ' ****** Next y out of place ****** Next y End If Next y 

在隔离有问题的部分时，下面的代码在我的数据表上工作：

 Sub test_yRange() Dim rng As Range Dim y As Range Set rng = Worksheets("Sheet1").Range("A1:D5") For Each y In rng ' working now If Not IsEmpty(y) And y > 7.5 And y <> "" And IsNumeric(y) Then ' I am passing the If above when a certain cell has a value of 8 y.Select With ActiveCell.Offset(0, i).Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorAccent3 .TintAndShade = -0.249977111117893 .PatternTintAndShade = 0 End With End If Next y End Sub