加速 Excel VBA 搜索脚本

Posted 2023-04-13

【中文标题】加速 Excel VBA 搜索脚本

【英文标题】：Speed up Excel VBA search script

【发布时间】：2015-02-05 16:06:24

【问题描述】：

我需要搜索重复值并在 Excel 电子表格中标记它们。我在D 列中有要验证的数据，而可能重复的数据在K 列中。我需要检查列中的每一行 D 列中的所有行。 K.

这是我目前的脚本：

Sub MySub()
Dim ThisCell1 As Range
Dim ThisCell2 As Range
    For Each ThisCell1 In Range("D1:D40000")
    'This is the range of cells to check
        For Each ThisCell2 In Range("K1:K40000")
        'This is the range of cells to compare
            If ThisCell1.Value = ThisCell2.Value Then
            If ThisCell1.Value <> "" Then
                ThisCell1.Interior.ColorIndex = 3
                End If
                Exit For
                End If
            Next ThisCell2
        Next ThisCell1
End Sub

问题在于它非常很慢。我的意思是检查不可接受的数据需要小时。即使范围设置为1:5000，仍需要 10-15 分钟才能完成。有什么办法让它更快？

【问题讨论】：

您如何定义您的搜索？您是否正在检查 D 列中的值是否出现在 K 列中？还是必须不止一次出现在 K 列中？

我正在检查K 列中的值是否出现在D 列中。 D 列中可能出现多次，这就是为什么搜索必须检查 K 中的所有行的原因 D 中的每一行

【参考方案1】：

字典将是实现所需内容的最快方法。不要忘记在您的项目中添加对“Microsoft 脚本运行时”的引用

Sub MySubFast()
    Dim v1 As Variant
    Dim dict As New Scripting.Dictionary
    Dim c As Range

    v1 = Range("D1:D40000").Value
    For Each c In Range("K1:K40000")
        If Not dict.Exists(c.Value) Then
            dict.Add c.Value, c
        End If
    Next

    Dim i As Long
    For i = LBound(v1, 1) To UBound(v1, 1)
        If v1(i, 1) <> "" Then
            If dict.Exists(v1(i, 1)) Then
                Range("D" & i).Interior.ColorIndex = 3

            End If
        End If
    Next i
End Sub

注意：这是对@Jeanno 答案的改进。

【讨论】：

我的脚本在 D 列中有 13k 行，在 K 列中有 4.5k 行，需要 2 个多小时才能完成。你的版本花了 6 分钟 :))

【参考方案2】：

使用数组而不是更快地引用对象（范围）。

Sub MySubFast()
    Dim v1 As Variant
    Dim v2 As Variant
    v1 = Range("D1:D40000").Value
    v2 = Range("K1:K40000").Value
    Dim i As Long, j As Long
    For i = LBound(v1, 1) To UBound(v1, 1)
        For j = LBound(v2, 1) To UBound(v2, 1)
            If v1(i, 1) = v2(j, 1) Then
                If v1(i, 1) <> "" Then
                    Range("D" & i).Interior.ColorIndex = 3
                End If
                Exit For
            End If
        Next j
    Next i
End Sub

【参考方案3】：

如果值存在于 K 列中，您不只是突出显示 D 列中的单元格吗？不需要 VBA，只需使用条件格式即可。

选择 D 列（选择整列即可） 使用以下公式添加条件格式：=COUNTIF($K:$K,$D1)>0

当您更改 D 和 K 列中的数据时，条件格式将自动应用和更新，它应该基本上是即时的