vba 为固定范围的单元格设置背景颜色
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/2746185/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Set the background color for a fixed range of cells
提问by Count Boxer
I have VBA code in an Excel spreadsheet. It is used to set the font and background color of a cell based on the value in that cell. I am doing it in VBA instead of "Conditional Formatting" because I have more than 3 conditions. The code is:
我在 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
The problem is in the "c.Range" line. It always uses the current cell as "A" and then goes four cells to the right. I want it to start in the "real" cell "A" of the current row and go to the "real" cell "D" of the current row. Basically, I want a fixed range and not a dynamic one.
问题出在“c.Range”行中。它始终使用当前单元格作为“A”，然后向右移动四个单元格。我希望它从当前行的“真实”单元格“A”开始，然后转到当前行的“真实”单元格“D”。基本上，我想要一个固定范围而不是动态范围。
采纳答案by mechanical_meat
So c.Range("A1:D1")has its own relative range.
One solution is to use the worksheet's range property instead.
I added two lines towards the top (#added), and changed one at the bottom (#changed).
所以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
