Question

我要做的是将特定范围单元格更改为特定颜色。它的作用是当有增加时，当它超过-2.00％时应该是红色。但是，当它从前一次减少时它应该是绿色，一旦它低于-2.00％，它应该再次变黑。

所以基本上数据的单元格从C2开始，到H54结束。它以行格式工作，其中C2是主要的，然后D2是继续数据等.C3是新的主数据，D3是该数据的继续等。

我一直在测试但未正确的代码如下：

Range("C2").Select
If Range("C2").Value >= "-2.00%" Then
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
ElseIf Range("C2").Value < "-2.00%" Then
With Selection.Font
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
End With
End If

Range("D2").Select
If Range("D2").Value <= "-2.00%" & Range("C2").Value Then
With Selection.Font
.Color = -11489280
.TintAndShade = 0
End With
ElseIf Range("D2").Value > "-2.00%" & Range("C2").Value Then
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
ElseIf Range("D2").Value < "-2.00%" Then
With Selection.Font
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
End With
End If

Range("E2").Select
If Range("E2").Value <= "-2.00%" & Range("D2").Value Then
With Selection.Font
.Color = -11489280
.TintAndShade = 0
End With
ElseIf Range("E2").Value > "-2.00%" & Range("D2").Value Then
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
ElseIf Range("E2").Value < "-2.00%" Then
With Selection.Font
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
End With
End If

然而，当它低于2.00％时仍然是绿色，即使再次增加也会出现同样的错误......

我会很感激尽快完成这项工作......如果你知道一个更短的方法，请把它放下来让我测试一下。非常感谢您抽出时间对此进行审核。

以下是结果的示例图片及其实际应用内容：

Answer 1

这似乎遵循您的业务逻辑，因为我从代码和示例图像中感知它。

Sub ject()
    Dim r As Long, c As Long, vRTRNs As Variant, thrshld As Double

    thrshld = 0.02

    With Worksheets("Sheet2")
        With .Cells(1, 1).CurrentRegion
            With .Resize(.Rows.Count - 1, .Columns.Count - 2).Offset(1, 2)
                .Cells.Font.ColorIndex = xlColorIndexAutomatic
                vRTRNs = .Value2
                For r = LBound(vRTRNs, 1) To UBound(vRTRNs, 1)

                    'deal with the first value
                    If vRTRNs(r, LBound(vRTRNs, 2)) >= thrshld Then
                        .Cells(r, 1).Font.Color = vbRed
                    End If

                    'the remainder of the columns in the row
                    For c = LBound(vRTRNs, 2) + 1 To UBound(vRTRNs, 2)
                        Select Case vRTRNs(r, c)
                            Case Is >= thrshld
                                .Cells(r, c).Font.Color = _
                                    IIf(vRTRNs(r, c) >= vRTRNs(r, c - 1), vbRed, vbGreen)
                            Case Is < thrshld
                                .Cells(r, c).Font.ColorIndex = xlColorIndexAutomatic
                        End Select
                    Next c
                Next r
            End With
        End With
    End With
End Sub

结果：

使用Excel VB相应地从Access颜色编码更改导入的数据

1 个答案: