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

Question

我正在尝试创建一个宏来划分单元格值，如果该值大于 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

该宏用于显示一周的工作量，灰色单元格是周末，因此需要跳过。

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