[英]Excel: Using VBA to apply conditional formatting to blank cells in individula columns
[英]vba conditional formatting to columns
我是VBA的新手,所以我遇到了几个问题。
我有一个如下所示的数据集:
我必须将A列与B,C,D,E和F列进行比较,然后在这些条件下为B:F列中的单元格着色:
我试图写一个简单的宏,除了第4个以外满足所有条件。
这是我的尝试。
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
谁能帮助我? 我不明白为什么第四个条件没有达到所有其他条件。
先感谢您!
要为字体着色,必须使用Range的Font属性,如:Selection.Font.Color = RGB(255,128,0)。
你可以尝试这个(注释)代码:
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.