如何使用Excel VBA根据每个单元格中的值自动格式化行？

Question

我有一个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

- Mohamed Heiba

---

你目前尝试了什么？我看到你标记了“条件格式”，你尝试了哪些格式规则？哪些有效，哪些无效？ - BruceWayne

我有很多应用于另一个工作表的Excel条件格式规则。这次我想用VBA来实现它。我知道如何在VBA中检查更改是否发生，方法是："Private Sub Worksheet_Change(ByVal Target As Range)"，并且我知道如何使用"If ((Not Intersect(Target, Range("B:B")) Is Nothing)) Then"来检查交集。 - Mohamed Heiba

请问您能否将代码编辑到您的原始帖子中，并使用代码标签（{}）进行标记吗？谢谢！ - BruceWayne

所提供的代码与要求无关... - Robin Mackenzie

@RobinMackenzie 是的，这只是为了展示我目前所拥有的。这就是为什么我在寻求答案。 - Mohamed Heiba

Answer 1

尝试使用这段代码：

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表格），那么我们可以修改上面的代码，使其监视此表格的前三列，无论第一列从哪里开始（在"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 

- Fadi

Answer 2

我假设你的表格（有三列）存在于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

这将在数据修改时格式化行（就像条件格式化一样）。

另外，如果您需要一次性格式化整个表格，则可以按照Fadi在回复中所示的方式为表格的每一行调用DefineFormat例程。

- ArindamD