查找已用任何颜色填充的所有单元格并在excel vba中突出显示相应的列标题 [英] Finding all cells that have been filled with any color and highlighting corresponding column headers in excel vba

问题描述

我的问题:

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

I've made a large (2,000 line) macro that runs on our company's template and fixes some common issues and highlights other issues we have prior to importing. The template file always has 150 columns and is in most instances 15,000+ rows (sometimes even over 30,000). The macro works well, highlighting all the cells that contain errors according to our data rules, but with a file with so many columns and rows I thought it'd be convenient to add a snippet to my macro that would have it find all of the cells that have been highlighted and then highlight the column headers of the columns that contain those highlighted cells.

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

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

• SpecialCellsxlCellTypeAllFormatConditions only works for conditional formatting, so that isn't a plausible method for my situation

Rick Rothstein的UDF，来自

Rick Rothstein's UDF from 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中仅找到一种颜色填充，需要花费相当多的时间.

This would be perfect with a few tweaks, except our files can have multiple colorfills. Since our template is so large I've learned that it takes quite some time to run one instance of Find to find just one colorfill in the UsedRange.

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

Using filtering, maybe cycling through all the columns and checking each if they contain any cell that has any colorfill. Would that be any faster though?

所以，我的问题:

1. 我如何才能找到所有包含任何颜色填充单元格的列?更具体地说，最有效(最快)的方法是什么?

1. How could I accomplish finding all columns that contain any colorfilled cells? More specifically, what would be the most efficient (fastest) way to achieve this?

推荐答案

最有效的解决方案是使用半间隔递归进行搜索. 标记工作表中具有150列和30000行的列所需的时间不到5秒.

The most performant solution would be to search using recursion by half-interval. It takes less than 5 seconds to tag the columns from a worksheet with 150 columns and 30000 rows.

搜索特定颜色的代码:

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

这篇关于查找已用任何颜色填充的所有单元格并在excel vba中突出显示相应的列标题的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！