为一定范围的单元格设置背景颜色

Question

为一定范围的单元格设置背景颜色

4

我有一个Excel电子表格中的VBA代码。它用于根据单元格中的值设置字体和背景颜色。我之所以使用VBA而不是“条件格式化”，是因为我有超过3个条件。代码如下：

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range, d As Range, fc As Long, bc As Long, bf As Boolean
Set d = Intersect(Range("A:K"), Target)
If d Is Nothing Then Exit Sub
For Each c In d
    If c >= Date And c <= Date + 5 Then
        fc = 2: fb = True: bc = 3
    Else
        Select Case c
            Case "ABC"
                fc = 2: fb = True: bc = 5
            Case 1, 3, 5, 7
                fc = 2: fb = True: bc = 1
            Case "D", "E", "F"
                fc = 2: fb = True: bc = 10
            Case "1/1/2009"
                fc = 2: fb = True: bc = 45
            Case "Long string"
                fc = 3: fb = True: bc = 1
            Case Else
                fc = 1: fb = False: bc = xlNone
        End Select
    End If
    c.Font.ColorIndex = fc
    c.Font.Bold = fb
    c.Interior.ColorIndex = bc
    c.Range("A1:D1").Interior.ColorIndex = bc
Next
End Sub

问题在于“c.Range”一行代码。它总是将当前单元格作为“A”，然后向右移动四个单元格。我希望它从当前行的“真实”单元格“A”开始，直到“真实”单元格“D”。基本上，我想要一个固定的范围而不是一个动态的范围。

- Count Boxer

只是为了核实，我假设你担心允许的条件数量，因为这将被交付给不仅使用xl2007的用户？ - guitarthrower

我们正在使用似乎只允许3个条件的Excel 2003版本。用户需要对6个条件进行测试，包括日期范围，但无法在向导中实现。 - Count Boxer

1个回答

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- mechanical_meat · Accepted Answer

因此，c.Range("A1:D1")具有自己的相对范围。
解决方案之一是改用工作表的范围属性。
我在顶部添加了两行（#added），并更改了底部的一行（#changed）。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range, d As Range, fc As Long, bc As Long, bf As Boolean
Dim ws As Worksheet ''#added

Set d = Intersect(Range("A:K"), Target).Cells
Set ws = d.Worksheet ''#added
If d Is Nothing Then Exit Sub
For Each c In d.Cells
    If c >= Date And c <= Date + 5 Then
        fc = 2: bf = True: bc = 3
    Else
        Select Case c.Value
            Case "ABC"
                fc = 2: bf = True: bc = 5
            Case 1, 3, 5, 7
                fc = 2: bf = True: bc = 1
            Case "D", "E", "F"
                fc = 2: bf = True: bc = 10
            Case "1/1/2009"
                fc = 2: bf = True: bc = 45
            Case "Long string"
                fc = 3: bf = True: bc = 1
            Case Else
                fc = 1: bf = False: bc = xlNone
        End Select
    End If
    c.Font.ColorIndex = fc
    c.Font.Bold = bf
    c.Interior.ColorIndex = bc
    ws.Cells(c.Row, 1).Interior.ColorIndex = bc ''#changed
    ws.Cells(c.Row, 2).Interior.ColorIndex = bc ''#added
    ws.Cells(c.Row, 3).Interior.ColorIndex = bc ''#added
    ws.Cells(c.Row, 4).Interior.ColorIndex = bc ''#added
Next
End Sub