Excel 条件突出显示：如何优化？

我有代码，完全达到我想要的。我的代码的基础来自Tim Williams在前一篇文章中的慷慨帮助。在他的帮助的基础上，我稍微增加了一些功能（较大的字体大小，如果未选择列中的任何内容，则返回原始格式），并将代码扩展到多个列，如代码所示

问题是我的电子表格现在慢得令人无法忍受。有没有办法加快速度

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim r As Range, c As Range

    'Set target for all columns that have this functionality
    Set r = Intersect(Me.Range("N:Q"), Target)

    'The functionality is repeated for several columns and is identical each time (except for N which maps to two columns)

    'Column N maps to columns H & I
    If Not Application.Intersect(Target, Range("N:N")) Is Nothing Then

    If r Is Nothing Or Target.Cells.CountLarge > 960 Then Exit Sub

    Application.ScreenUpdating = False
        HighlightIt Application.Intersect(Me.Range("H:I"), Me.UsedRange), False
        For Each c In r.Cells
            HighlightIt Me.Cells(c.Row, "H").Resize(1, 2)
        Next c

    Else
         With Application.Intersect(Me.Range("H:I"), Me.UsedRange)
            .Font.Bold = False
            .Font.Color = vbBlack
            .Font.Size = 14

          End With
    End If

    'Column O maps to columns J
     If Not Application.Intersect(Target, Range("O:O")) Is Nothing Then

    If r Is Nothing Or Target.Cells.CountLarge > 960 Then Exit Sub

    Application.ScreenUpdating = False
        HighlightIt Application.Intersect(Me.Range("J:J"), Me.UsedRange), False
        For Each c In r.Cells
            HighlightIt Me.Cells(c.Row, "J")
        Next c


    Else
         With Application.Intersect(Me.Range("J:J"), Me.UsedRange)
            .Font.Bold = False
            .Font.Color = vbBlack
            .Font.Size = 14

          End With
    End If


   'Column P maps to columns K
    If Not Application.Intersect(Target, Range("P:P")) Is Nothing Then

    If r Is Nothing Or Target.Cells.CountLarge > 960 Then Exit Sub

    Application.ScreenUpdating = False
        HighlightIt Application.Intersect(Me.Range("K:K"), Me.UsedRange), False
        For Each c In r.Cells
            HighlightIt Me.Cells(c.Row, "K")
        Next c

    Else
         With Application.Intersect(Me.Range("K:K"), Me.UsedRange)
            .Font.Bold = False
            .Font.Color = vbBlack
            .Font.Size = 14

          End With
    End If

    'Column Q maps to columns L
    If Not Application.Intersect(Target, Range("Q:Q")) Is Nothing Then

    If r Is Nothing Or Target.Cells.CountLarge > 960 Then Exit Sub

    Application.ScreenUpdating = False
        HighlightIt Application.Intersect(Me.Range("L:L"), Me.UsedRange), False
        For Each c In r.Cells
            HighlightIt Me.Cells(c.Row, "L")
        Next c

       Else
         With Application.Intersect(Me.Range("L:L"), Me.UsedRange)
            .Font.Bold = False
            .Font.Color = vbBlack
            .Font.Size = 14

          End With
    End If

End Sub

'utility sub for highlighting/unhighlighting
Sub HighlightIt(rng As Range, Optional hilite As Boolean = True)
    With rng
        .Font.Color = IIf(hilite, vbWhite, vbBlack)
        .Font.Bold = hilite
        .Font.Size = IIf(hilite, 20, 14)
    End With
End Sub

---

达伦·巴特鲁普是对的。代码审查是一个很好的网站，可以帮助您提高代码的效率

我提供一个答案，因为我不确定你是否完全理解蒂姆·威廉姆斯的答案的精神。除了不需要迭代单元格外，您还应该能够在没有相同代码的情况下为每个测试列执行操作。可以通过创建某种形式的选定列来高亮显示列映射来实现这一点。下面是让您开始学习的基本代码

您提供的代码不应该像您描述的那样慢，因此我想知道您是否正在处理其他事件（或者您的

\u Select

事件中有更多代码）。如果有，那么请确保您将其包含在代码审查或此处的问题中

Option Explicit

Private mColumnMap As Collection
Private mOldRange As Range
Private mOldCellColour As Long

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim mappedRange As Range
    Dim mappedCells As Range

    'Define the column map.
    If mColumnMap Is Nothing Then
        Set mColumnMap = New Collection

        mColumnMap.Add Me.Range("H:I"), "14" 'N
        mColumnMap.Add Me.Range("J:J"), "15" 'O
        mColumnMap.Add Me.Range("K:K"), "16" 'P
        mColumnMap.Add Me.Range("L:L"), "17" 'Q
    End If

    'If there is a highlighted range, change it back.
    If Not mOldRange Is Nothing Then
        With mOldRange
            .Interior.Color = mOldCellColour
            .Font.Bold = False
        End With
        Set mOldRange = Nothing
    End If

    'Ignore any selections that are more than one column.
    If Target.Columns.Count <> 1 Then Exit Sub

    'Ignore any selections outside of a specified range.
    'Note: I've just used the 'UsedRange'.
    If Intersect(Target, Me.UsedRange) Is Nothing Then Exit Sub

    'Acquire the appropriate column map.
    On Error Resume Next
    Set mappedRange = mColumnMap(CStr(Target.Column))
    On Error GoTo 0

    'Exit if not a target column.
    If mappedRange Is Nothing Then Exit Sub

    'Define the cells to be changed.
    Set mappedCells = Intersect(mappedRange, Target.EntireRow)

    'Store the original values.
    Set mOldRange = mappedCells
    mOldCellColour = mappedCells(1).Interior.Color

    'Change the values.
    Application.ScreenUpdating = False
    With mappedCells
        .Interior.Color = vbWhite
        .Font.Bold = True
    End With
    Application.ScreenUpdating = True

End Sub

选项显式
私有McColumnMap作为集合
私人莫尔德兰奇牧场
私密的毛细胞颜色一样长
专用子工作表\u选择更改（ByVal目标作为范围）
Dim mappedRange作为范围
将单元格设置为范围
'定义列映射。
如果McColumnMap什么都不是，那么
设置mColumnMap=新集合
McColumnMap.AddMe.Range（“H:I”），“14”N
mColumnMap.addme.Range（“J:J”），“15”O
mColumnMap.addme.Range（“K:K”），“16”P
McColumnMap.AddMe.Range（“L:L”），“17”Q
如果结束
'如果有突出显示的范围，请将其更改回。
如果不是mOldRange什么都不是
和mOldRange
.Interior.Color=MoldCellColor
.Font.Bold=False
以
设置mOldRange=Nothing
如果结束
'忽略超过一列的所有选择。
如果Target.Columns.Count为1，则退出Sub
'忽略指定范围之外的任何选择。
注：我刚刚使用了“UsedRange”。
如果Intersect（Target，Me.UsedRange）为空，则退出Sub
'获取适当的列映射。
出错时继续下一步
设置mappedRange=mColumnMap（CStr（Target.Column））
错误转到0
'如果不是目标列，则退出。
如果mappedRange为Nothing，则退出Sub
'定义要更改的单元格。
设置mappedCells=Intersect（mappedRange，Target.EntireRow）
'存储原始值。
设置mOldRange=mappedCells
MoldCellColor=mappedCells（1）.Interior.Color
'更改值。
Application.ScreenUpdating=False
用mappedcell
.Interior.Color=vbWhite
.Font.Bold=True
以
Application.ScreenUpdating=True
端接头

这将更适合于。代码问题也是如此，代码审查是为了如何改进代码。啊，我不知道。干杯不幸的是，您的框架代码超出了我当前的VBA技能。例如，从我的角度来看，在定义变量之前对其使用if语句是没有意义的（请参阅McColumnMap）。我很好地掌握了根据前面的答案拼凑而成的代码，但你的代码似乎太离谱了。我知道SO不是一个代码编写平台，所以我不希望您为我编写代码，相反，我认为我将尝试简化代码的功能，以减少延迟。非常感谢您的贡献，我相信更好的VBAR将在未来受益！啊，是的，我应该说：

mColumnMap

是在模块级别定义的，即在页面顶部。我将添加此作为编辑。您应该可以粘贴此代码并使用它运行，但是如果您有一些已经可以使用的东西，那么，是的，使用它。祝你的项目好运，太棒了！不仅更快，而且更清晰。真的很感谢你帮助我，看到成品真是令人兴奋！再次感谢。