Vba 运行宏崩溃Excel

我试图运行宏，但现在它一直冻结excel。 它使用10个单元格运行，但当宏应用于近200个单元格时，它会冻结并崩溃

Sub eancheck()

    Dim s1 As Worksheet, s2 As Worksheet
    Dim Msg As String
    Set s1 = Sheets("Sheet1")
    Set s2 = Sheets("Sheet3")
    Dim lr1 As Long, lr2 As Long
    lr1 = s1.Range("A" & Rows.Count).End(xlUp).Row
    lr2 = s2.Range("a" & Rows.Count).End(xlUp).Row
    Dim i As Long, j As Long
    Application.ScreenUpdating = False
    For i = 2 To lr1
   s1.Cells(i, "D").Interior.ColorIndex = 0
        For j = 2 To lr2
            If s2.Range("A" & j) = s1.Range("D" & i) Then
                's1.Range("D" & i) = s2.Range("B" & j)
                s1.Cells(i, "D").Interior.ColorIndex = 3
            End If
        Next j
    Next i
    Application.ScreenUpdating = True

End Sub

我也有其他宏的问题，我想这是因为范围的大小。我怎样才能修好它

---

注意：在两列各有近200.000个值的工作表中搜索10个值时，宏会运行，但如果不是10而是200，则会崩溃。

在工作表中使用条件格式1和公式，并将其应用于D2:D5000或任何合适的范围

=计数如果（表3！A2，D2）>0

尝试分别声明所有必需的变量

在程序开始时使用Application.ScreenUpdate=false

for循环的第一行也可以在for循环之外

使用集合进行检查

例如，我从表1 Col A上的数据开始

数据如表3 Col A所示

这是我的宏

Sub eancheck()
    Application.ScreenUpdating = False
    Dim s1 As Worksheet
    Dim s2 As Worksheet
    Dim Msg As String
    Dim lr1 As Long
    Dim lr2 As Long
    Dim i As Long
    Dim j As Long
    Dim Sheet1ObjectsCol As Collection
    Dim Sheet3ObjectsCol As Collection
    Dim IdentifierCol As Collection

Set s1 = ThisWorkbook.Sheets("Sheet1")
Set s2 = ThisWorkbook.Sheets("Sheet3")

Set Sheet1ObjectsCol = New Collection
Set Sheet3ObjectsCol = New Collection
Set IdentifierCol = New Collection

lr1 = s1.Range("A" & Rows.Count).End(xlUp).Row
lr2 = s2.Range("a" & Rows.Count).End(xlUp).Row
s1.Range("D2" & ":" & "D" & lr1).Interior.ColorIndex = 0


'Load the collections
For i = 2 To lr1
Sheet1ObjectsCol.Add s1.Range("A" & i).Value
Next



'Load the collections
 On Error Resume Next
 For i = 2 To lr2
 Sheet3ObjectsCol.Add s2.Range("A" & i).Value, CStr(s2.Range("A" & i).Value)
 Next



'Create the Identifier Collection
For i = 1 To Sheet1ObjectsCol.Count
            ColorValReq = 0
    For j = 1 To Sheet3ObjectsCol.Count
        If Sheet1ObjectsCol(i) = Sheet3ObjectsCol(j) Then
            ColorValReq = 3
            GoTo Idenitified
        End If
    Next

Idenitified:
IdentifierCol.Add ColorValReq
Next

For i = 1 To IdentifierCol.Count
    j = i + 1
    If IdentifierCol(i) = 3 then
      s1.Range("D" & j).Interior.ColorIndex = IdentifierCol(i)
    End if
Next

Application.ScreenUpdating = True

End Sub

这是我得到的结果

---

在穿过lr1=和lr2=行时，按F8键一步一步执行代码。将鼠标悬停在这两个变量上，查看它们所包含的内容。Dim i尽可能长，j尽可能长最明显的是lr1和lr2的值是多少。我怀疑你需要两个环。还有，为什么不使用条件格式呢？我还以为colorindex刻度上的填充值是-4142。@CátiaFonseca您有两个循环，对于一个I值，它在本例中为j迭代了200次，这不是必需的。我认为CF是有意义的，但我认为它必须是

=COUNTIF（Sheet3！A2:A1000，D2）>0

或类似的？`=isnumber（匹配（…）它减少了计算周期。是的！我会的！非常感谢。少运行一个宏@SJR，没错！工作得很有魅力。我运行了一个宏以避免用户删除条件，但我认为这是excel不崩溃的唯一方法。我在您的代码中遇到了一个错误。对象工作表的方法范围在s1中失败。范围（D2&“：”&“D”&lr1）。Interior.ColorIndex=0您能帮忙吗？也许我必须调整范围，但对我来说似乎是对的。我的错误-尝试一下这个-s1.range（“D2”&“&“&”D”&lr1）。Interior.ColorIndex=0，应该可以。您还可以告诉我工作簿中Sheet1中A列和Sheet3中A列的最后一行吗？您还可以在集合中加载所有这些对象并运行它。那会比这快得多。它工作了，但又冻结了！我的错。那么，如何将数据加载到集合中呢。对不起，我对excel不是很在行，我只是想做几个宏来让别人的生活更轻松/更快。没问题。请在表格1和表格3的colA中提供一个小样本数据以及您的预期输出。我更感兴趣的是看到预期的产出。