运行宏会导致 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

我也遇到了其他宏的问题，我认为是因为范围的大小。我该如何解决？

注意：当在包含两列的工作表中搜索 10 个值时，宏会运行，每列几乎有 200.000 个值，但是当 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 上的此类数据开始，

Sheet 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

这是我得到的输出，