MS Excel 根据字体颜色选择行

Question

我有大量关于员工合同的数据，创建了一个宏来自动将过期员工行的字体颜色更改为“红色”颜色，并弹出 MsgBox 以提醒用户大量过期数据。

下面是代码。

Sub Worksheet_Activate()

  Dim startCell As Integer, endCell As Integer
  Dim column As Integer
  Dim CountCells As Integer
  Dim x As Integer

  With Worksheets("Sheet1")

  lastrow = Range("L1048576").End(xlUp).Row

  CountCells = 0

  For i = 4 To lastrow

      If Range("L" & i).Value <> "" And Now <> "" Then

          If Range("L" & i).Value <= Now Then

              Range("L" & i).Font.ColorIndex = 3

                  If Range("L" & i).Font.ColorIndex = 3 Then

                     CountCells = CountCells + 1

                  End If
          End If
      End If
  Next i

     MsgBox CountCells & " expiring"

  End With
End Sub

现在我需要 Excel 通过单击按钮自动选择它们中的每一个，面临的问题是：

• 应该使用哪个按钮？表单控件按钮还是 ActiveX 控件按钮？

• 需要 3 个按钮，(1) 自动选择 (2) 复制和粘贴 (3) 删除每个选定的行。

• 如何为每个按钮编写代码？
• 用户点击 (1) 按钮后，将自动选择每个 RED 数据。
• 然后按 (2) 按钮，它会将它们复制到新工作表中。
• 最后，当用户按下（3）按钮时，每个选定的行将被删除，因为只删除了它们中的每一个，只有剩余的数据将替换空白空间。

Answer 1

无需循环遍历您的单元格。设置条件格式规则以在 L 列中的日期小于 Now 时将字体颜色变为红色。有了这个，Range.AutoFilter Method 可以过滤红色字体单元格。

Sub red_font_cells()
    With Worksheets("Sheet1")
        'turn off AutoFilter if it is on
        If .AutoFilterMode Then .AutoFilterMode = False
        'set a CF rule for <Now
        With .Range(.Cells(2, "L"), .Cells(Rows.Count, "L").End(xlUp))
            .FormatConditions.Delete
            With .FormatConditions.Add(Type:=xlExpression, Formula1:="=$L2<NOW()")
                .Font.Color = vbRed
            End With
        End With
        'add an AutoFilter for red font cells
        With .Range(.Cells(1, "L"), .Cells(Rows.Count, "L").End(xlUp))
            .AutoFilter Field:=1, Criteria1:=vbRed, _
                        Operator:=xlFilterFontColor
        End With
        'deal with the red font cells
        With .Range(.Cells(2, "L"), .Cells(Rows.Count, "L").End(xlUp))
            If CBool(Application.Subtotal(103, .Cells)) Then
                With .SpecialCells(xlCellTypeVisible)
                    'select them (there are better ways to get things done)
                    '.Select
                    'copy them to sheet2 (do not need Select for this)
                    .Copy Destination:=Sheet2.Range("A1")
                    'delete them
                    .EntireRow.Delete
                End With
            End If
        End With
        'turn off AutoFilter
        If .AutoFilterMode Then .AutoFilterMode = False
    End With
End Sub

我会使用 ActiveX 类型的按钮。您可以右键单击它们以查看代码。