運行宏崩潰Excel

Question

我正在嘗試運行一個宏，但現在它一直在凍結。 它運行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（表Sheet 3！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

這是我得到的輸出，