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

基于原始细胞值，以不同的阴影着色多个细胞

1 个答案: