加速 Excel VBA 搜索脚本

Speed up Excel VBA search script

我需要搜索重复值并在 Excel 电子表格中标记它们。我的数据在 D 列中验证,可能重复的数据在 K 列中。我需要检查第 D 列中的每一行,以及 col 中的所有行。 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 分钟才能完成。有什么方法可以让它更快吗?

使用数组比引用对象(范围)更快。

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

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

  • Select D列(全选即可)
  • 使用此公式添加条件格式:=COUNTIF($K:$K,$D1)>0

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

字典将是实现您所寻找内容的最快方式。不要忘记在项目

中添加对 'microsoft scripting runtime' 的引用
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 答案的改进。