运行在另一张工作表上运行的宏时 Excel 冻结

运行在另一张工作表上运行的宏时 Excel 冻结

当我在包含几列的示例文档上运行下面的代码时,它工作正常,但是当我在更大的文档上运行它时,excel 就会冻结
样本文件

示例文档代码

Sub RCOps_Compare()
 Application.ScreenUpdating = False
   Dim lRow As Long, v As Variant
   Dim dic As Object, i As Long, rowCount As Long
   Dim jobNo As String, Traveller As String, OpSeq As String
   Dim rng As Range

   Set rng = Range("A4", Range("A" & Rows.Count).End(xlUp))
   v = Range("A4", Range("A" & Rows.Count).End(xlUp)).Resize(, 4).Value '31
   Set dic = CreateObject("Scripting.Dictionary")

For i = LBound(v) To UBound(v)
    jobNo = Split(v(i, 1), "-")(0)
    With ActiveSheet
        .Range("A4").CurrentRegion.AutoFilter 1, jobNo & "*"
        rowCount = [subtotal(103,A:A)] - 1
        With rng.SpecialCells(xlCellTypeVisible)
            lRow = .Areas(.Areas.Count).Row + .Areas(.Areas.Count).Rows.Count - 1
        End With
        
        If rowCount = 1 Then
            Traveller = Split(v(i, 1), "-")(1)
            OpSeq = Split(v(i, 1), "-")(2)
                          
            If jobNo = v(i, 2) And Traveller = v(i, 3) And OpSeq = v(i, 4) Then
                Range("D" & i + 1) = "* " & v(i, 4)
                MsgBox (v & " ")
            End If
        Else
            If Not dic.Exists(jobNo) Then
                dic.Add jobNo, Nothing
                Range("D" & lRow) = "* " & v(i + rowCount - 1, 4)
            End If
        End If
    End With
Next i
Application.ScreenUpdating = True
End Sub

其他版本

Sub RCOps_Compare()
 Application.ScreenUpdating = False
   Dim lRow As Long, v As Variant
   Dim dic As Object, i As Long, rowCount As Long
   Dim jobNo As String, Traveller As String, OpSeq As String
   Dim rng As Range

   Set rng = Range("A4", Range("A" & Rows.Count).End(xlUp))
   v = Range("A4", Range("A" & Rows.Count).End(xlUp)).Resize(, 4).Value '31
   Set dic = CreateObject("Scripting.Dictionary")

For i = LBound(v) To UBound(v)
    jobNo = Split(v(i, 1), "-")(0)
    With ActiveSheet
        .Range("A4").CurrentRegion.AutoFilter 1, jobNo & "*"
        rowCount = [subtotal(103,A:A)] - 1
        With rng.SpecialCells(xlCellTypeVisible)
            lRow = .Areas(.Areas.Count).Row + .Areas(.Areas.Count).Rows.Count - 1
        End With
        
        If rowCount = 1 Then
            Traveller = Split(v(i, 1), "-")(1)
            OpSeq = Split(v(i, 1), "-")(2)
                          '29 30 31
            If jobNo = v(i, 29) And Traveller = v(i, 30) And OpSeq = v(i, 31) Then
                Range("AE" & i + 1) = "* " & v(i, 31)
                MsgBox (v & " ")
            End If
        Else
            If Not dic.Exists(jobNo) Then
                dic.Add jobNo, Nothing
                Range("AE" & lRow) = "* " & v(i + rowCount - 1, 31)
            End If
        End If
    End With
Next i
Application.ScreenUpdating = True
End Sub

我最想知道为什么它对一个文档有效,但对另一个更大的文档无效(即使列号已调整),我无法为更大的文件插入示例)

相关内容