我有Table1
A栏有一个日期，例如30/5/2017
B列的状态为“成功”
C列的值为例如500
要求：更改单元格时在VBA中应用自定义条件格式
假设改变发生在第5行的A，B或C列
中无论更改是在A列，B列还是C列中发生，都应执行相同的逻辑。
如果A列值小于Now（），则第5行应为红色背景和白色文本。不应该进行进一步的检查。
否则如果B列为“成功”，则第5行应为绿色背景和白色文本。不应该进行进一步的检查。
否则如果C列的值小于500，则第5行应为蓝色背景和白色文本。不应该进行进一步的检查。
下面的VBA代码是检查单元格上的更改 - 它使用超链接自动格式化b列中的单元格。
我现在需要的是根据上述标准自动整形整行。
Private Sub Worksheet_Change(ByVal Target As Range)
If ((Not Intersect(Target, Range("B:B")) Is Nothing) Or (Not Intersect(Target, Range("F:F")) Is Nothing) Or (Not Intersect(Target, Range("G:G")) Is Nothing) Or (Not Intersect(Target, Range("I:I")) Is Nothing)) Then
End If
End Sub
答案 0 :(得分：5)
试试这段代码：
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, R As Range
Dim fCol As Long, bCol As Long
Set Rng = Application.Intersect(Target, Columns("A:C"))
If Not Rng Is Nothing Then
Set Rng = Application.Intersect(Rng.EntireRow, Columns("A:C"))
fCol = vbWhite
For Each R In Rng.Rows
If R.Cells(1, 1).Value <> vbNullString And R.Cells(1, 1).Value < Now Then
bCol = vbRed
ElseIf R.Cells(1, 2).Value <> vbNullString And R.Cells(1, 2).Value = "Success" Then
bCol = vbGreen
ElseIf R.Cells(1, 3).Value <> vbNullString And R.Cells(1, 3).Value < 500 Then
bCol = vbBlue
Else
bCol = xlNone
fCol = vbBlack
End If
R.EntireRow.Interior.Color = bCol
R.EntireRow.Font.Color = fCol
Next
End If
End Sub
修改：
我有Table1
如果Table1是ListObject（Excel tables），那么我们可以修改上面的代码，使其能够监视此表的前三列，而不管第一列的起始位置（在第34行中） ; A＆＃34;或＆＃34; B＆＃34;或等...），并且只格式化表行而不是整行：
Private Sub Worksheet_Change(ByVal Target As Range)
Dim LObj As ListObject
Dim RngToWatch As Range
Dim Rng As Range, R As Range
Dim fCol As Long, bCol As Long
Set LObj = ListObjects("Table1") ' the name of the table
Set RngToWatch = Range(LObj.ListColumns(1).DataBodyRange, LObj.ListColumns(3).DataBodyRange)
Set Rng = Application.Intersect(Target, RngToWatch)
If Not Rng Is Nothing Then
Set Rng = Application.Intersect(Target.EntireRow, RngToWatch)
fCol = vbWhite
For Each R In Rng.Rows
If R.Cells(1, 1).Value <> vbNullString And R.Cells(1, 1).Value < Now Then
bCol = vbRed
ElseIf R.Cells(1, 2).Value <> vbNullString And R.Cells(1, 2).Value = "Success" Then
bCol = vbGreen
ElseIf R.Cells(1, 3).Value <> vbNullString And R.Cells(1, 3).Value < 500 Then
bCol = vbBlue
Else
bCol = xlNone
fCol = vbBlack
End If
With Application.Intersect(LObj.DataBodyRange, R.EntireRow)
.Interior.Color = bCol
.Font.Color = fCol
End With
Next
End If
End Sub
答案 1 :(得分：3)
我假设您的表（有三列）存在于Sheet1中。 因此，在Sheet1中添加以下代码（不在单独的模块中）
Private Sub Worksheet_Change(ByVal Target As Range)
Dim irow As Variant
' First identify the row changed
irow = Target.Row
' Invoke row formatter routine
Call DefineFormat(irow)
End Sub
然后在模块中添加以下代码（您可以在Sheet1下添加，但它将限制此模块的使用）
Sub DefineFormat(irow) ' Receive the row number for processing
Dim vVal As Variant
Dim Rng As Range
Dim lFont, lFill As Long
' Define the basis for validation
Dim Current, Success, limit As Variant ' Can be defined as constant as well
Current = Date ' Set today's date
Success = "Success" ' Set success status check
limit = 500 ' Set limit for value check
' Set range for the entire row - Columns A(index 1) to Column C (index 3)
Set Rng = Range(Application.ActiveSheet.Cells(irow, 1).Address, Application.ActiveSheet.Cells(irow, 3).Address)
lFont = vbWhite
' Assuming columns A, B and C needs to be formatted
If Application.ActiveSheet.Cells(irow, 1) < Current Then
lFill = vbRed ' Check for col A
Else:
If Application.ActiveSheet.Cells(irow, 2) = Success Then
lFill = vbGreen ' Check for col B
Else
If Application.ActiveSheet.Cells(irow, 3) < limit Then
lFill = vbBlue ' Check for col C
Else ' Default formatting
lFill = xlNone
lFont = vbBlack
End If
End If
End If
Rng.Interior.Color = lFill
Rng.Font.Color = lFont
End Sub
这将在修改数据时格式化行（就像条件格式化一样）
此外，如果您需要一次性格式化整个表格，那么您可以在表格的每一行的循环中调用DefineFormat例程，如Fadi在其回复中所示。