vba - 查找已填充任何颜色的所有单元格并突出显示 Excel VBA 中相应的列标题

Question

我的问题:

我制作了一个大型(2,000 行)宏，该宏在我们公司的模板上运行，修复了一些常见问题并突出显示了我们在导入之前遇到的其他问题。模板文件始终有 150 列，在大多数情况下有 15,000 多行(有时甚至超过 30,000 行)。该宏运行良好，根据我们的数据规则突出显示包含错误的所有单元格，但是对于包含如此多列和行的文件，我认为向我的宏添加一个片段会很方便，这样它就可以找到所有已突出显示的单元格，然后突出显示包含这些突出显示的单元格的列的列标题。

我在寻找解决方案时发现的方法:

• SpecialCells xlCellTypeAllFormatConditions仅适用于条件格式，因此这对于我的情况来说不是一个可行的方法

• Rick Rothstein 的 UDF，来自 here

  Sub FindYellowCells()
    Dim YellowCell As Range, FirstAddress As String
    Const IndicatorColumn As String = "AK"
    Columns(IndicatorColumn).ClearContents
    '   The next code line sets the search for Yellow color... the next line after it (commented out) searches
    '   for the ColorIndex 6 (which is usually yellow), so use whichever code line is applicable to your situation
    Application.FindFormat.Interior.Color = vbYellow
    'Application.FindFormat.Interior.ColorIndex = 6
    Set YellowCell = Cells.Find("*", After:=Cells(Rows.Count, Columns.Count), SearchFormat:=True)
    If Not YellowCell Is Nothing Then
      FirstAddress = YellowCell.Address
      Do
        Cells(YellowCell.Row, IndicatorColumn).Value = "X"
        Set YellowCell = Cells.Find("*", After:=YellowCell, SearchFormat:=True)
        If YellowCell Is Nothing Then Exit Do
      Loop While FirstAddress <> YellowCell.Address
    End If
  End Sub
  

  只要进行一些调整就可以完美，除非我们的文件可以有多种颜色填充。由于我们的模板太大，我了解到运行 Find 的一个实例需要相当长的时间。在 UsedRange 中仅查找一种颜色填充.

• 使用过滤，可能会循环遍历所有列并检查每个列是否包含具有任何颜色填充的任何单元格。那会更快吗？

所以，我的问题:

1. 如何找到包含任何颜色填充单元格的所有列？更具体地说，实现这一目标最有效(最快)的方法是什么？

Answer 1

最高效的解决方案是使用半间隔递归进行搜索。从包含 150 列和 30000 行的工作表中标记列只需不到 5 秒的时间。

搜索特定颜色的代码:

Sub TagColumns()
  Dim headers As Range, body As Range, col As Long, found As Boolean

  ' define the columns for the headers and body
  Set headers = ActiveSheet.UsedRange.Rows(1).Columns
  Set body = ActiveSheet.UsedRange.Offset(1).Columns

  ' iterate each column
  For col = 1 To headers.Count

    ' search for the yellow color in the column of the body
    found = HasColor(body(col), vbYellow)

    ' set the header to red if found, green otherwise
    headers(col).Interior.color = IIf(found, vbRed, vbGreen)
  Next

End Sub

Public Function HasColor(rg As Range, color As Long) As Boolean
  If rg.DisplayFormat.Interior.color = color Then
    HasColor = True
  ElseIf VBA.IsNull(rg.DisplayFormat.Interior.colorIndex) Then
    ' The color index is null so there is more than one color in the range
    Dim midrow&
    midrow = rg.Rows.Count \ 2
    If HasColor(rg.Resize(midrow), color) Then
      HasColor = True
    ElseIf HasColor(rg.Resize(rg.Rows.Count - midrow).Offset(midrow), color) Then
      HasColor = True
    End If
  End If
End Function

并搜索任何颜色:

Sub TagColumns()
  Dim headers As Range, body As Range, col As Long, found As Boolean

  ' define the columns for the headers and body
  Set headers = ActiveSheet.UsedRange.Rows(1).Columns
  Set body = ActiveSheet.UsedRange.Offset(1).Columns

  ' iterate each column
  For col = 1 To headers.Count

    ' search for any color in the column of the body
    found = VBA.IsNull(body(col).DisplayFormat.Interior.ColorIndex)

    ' set the header to red if found, green otherwise
    headers(col).Interior.color = IIf(found, vbRed, vbGreen)
  Next

End Sub