vba条件格式化为列

我是VBA的新手，所以我遇到了几个问题。

我有一个这样的数据集：

我必须比较A列和B，C，D，E和F列，然后在这些条件下对列B：F中的单元格的颜色进行着色：

1. 如果列A中的单元格与列B：F中的单元格相同，则将它们的字体涂成橙色。
2. 如果列A中的单元格高于列B：F中的单元格，则将其字体涂成红色。
3. 如果列A中的单元格低于列B：F中的单元格，则将其字体绘制为绿色。
4. 如果A列与其余列（B：F）之间的绝对差值小于1，则将其字体涂成橙色。

我试图写一个简单的macros，所有的条件都满足，除了第四。

这是我的尝试。

---

Sub ConditionalFormating() Dim i, j, a As Double a = 0.99 i = 2 j = 2 For j = 1 To 6 For i = 2 To 10 ActiveSheet.Cells(i, j).Select If ActiveSheet.Cells(i, j) - ActiveSheet.Cells(i, 1) >= a Then With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = RGB(255, 156, 0) .TintAndShade = 0 .PatternTintAndShade = 0 End With End If If ActiveSheet.Cells(i, j) - ActiveSheet.Cells(i, 1) <= a Then With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = RGB(255, 156, 0) .TintAndShade = 0 .PatternTintAndShade = 0 End With End If If ActiveSheet.Cells(i, j) > ActiveSheet.Cells(i, 1) Then With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = RGB(0, 255, 0) .TintAndShade = 0 .PatternTintAndShade = 0 End With End If If ActiveSheet.Cells(i, j) < ActiveSheet.Cells(i, 1) Then With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = RGB(255, 0, 0) .TintAndShade = 0 .PatternTintAndShade = 0 End With End If Next Next End Sub 

---

任何人都可以帮我吗？ 我不明白为什么第四种情况在所有其他情况下都不符合。

先谢谢你！

Answer 1

要为字体着色，必须使用Range的Font属性，如：Selection.Font.Color = RGB（255,128,0）。

Answer 2

你可以试试这个（注释）代码：

 Option Explicit Sub ConditionalFormating() Dim cell As Range, cell2 As Range, dataRng As Range Dim colOrange As Long, colRed As Long, colGreen As Long, col As Long colOrange = RGB(255, 156, 0) colRed = RGB(255, 0, 0) colGreen = RGB(0, 255, 0) With Worksheets("CF") '<--| reference the relevant worksheet (change "CF" to your actual worksheet name) Set dataRng = Intersect(.Columns("B:F"), .UsedRange) For Each cell In .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeConstants) '<-- loop through its column "A" not empty cells from row 1 down to last not empty one If WorksheetFunction.CountA(Intersect(dataRng, cell.EntireRow)) > 0 Then ' if current row has data For Each cell2 In Intersect(dataRng, cell.EntireRow).SpecialCells(xlCellTypeConstants) ' loop through current column "A" cell row not empty cells Select Case True '<-- check the current datum against the following conditions Case cell2.Value = cell.Value Or Abs(cell.Value - cell2.Value) < 1 'if current datum equals corresponding value in column "A" or their absolute difference is lower than 1 col = colOrange Case cell2.Value < cell.Value 'if current datum is lower then corresponding value in column "A" col = colRed Case cell2.Value > cell.Value 'if current datum is higher then corresponding value in column "A" col = colGreen End Select With cell2.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = col .TintAndShade = 0 .PatternTintAndShade = 0 End With Next cell2 End If Next cell End With End Sub