Autoformat行使用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

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