运行宏使Excel崩溃

Question

我正在尝试运行宏，但现在它使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时，崩溃。

Answer 1

在带有公式的sheet1中使用条件格式，并将其应用于D2：D5000之类的范围或合适的范围。

  

= COUNTIF（Sheet3！A2，D2）> 0

Answer 2

1. 尝试分别声明所有必需的变量。
2. 在程序的开头使用Application.ScreenUpdating = false。
3. for循环的第一行也可以在for循环之外。
4. 使用“收藏夹”进行检查。

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

以及工作表3栏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

这是我得到的输出，