使用Excel VBA基于每个单元格中的值的Autoformat行？
我有Table1
A列有一个例如30/5/2017的date
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 试试这个代码：
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表格 ），那么我们可以修改上面的代码，使它能够监视这个表格的前三列，而不pipe第一列的起始位置（在“A”或“B”列等等）并只格式化表格而不是EntireRow：
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
我假设你的表（有三列）出现在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在其回复中所示。