Ускорение времени выполнения в макросе VBA excel с двойной петлей

На самом деле у меня есть некоторый рабочий код, хотя с учетом количества данных, которые у меня есть, и способа, которым я написал код, выполнение занимает более часа, и мне все еще нужно добавить немало кода для фактического анализа данных. Я использую двойной цикл, и до того, как я добавил screenupdating = false, казалось, что цикл, вложенный внутрь, был тем, что занимало так много времени.

Вот что у меня есть:

Sub LReview()

 Dim SecX As Workbook, LipR As Workbook
 Dim ws As Worksheet, Xws As Worksheet, Fsheet As Worksheet
 Dim i As Long, XwsRows As Long

 Path = ThisWorkbook.Path & "\"

Set LipR = ThisWorkbook
Set SecX = Application.Workbooks.Open(Path & "SecurityXtract_Mnthly.csv")
Windows("SecurityXtract_Mnthly.CSV").Activate
Set Xws = Sheets("SecurityXtract_Mnthly")

With Xws
    XwsRows = .Range("B" & .Rows.Count).End(xlUp).Row
End With

Windows("LMacro.xlsm").Activate
Sheets.Add.Name = "Funds"
Set ws = Sheets("Funds")

    Windows("SecurityXtract_Mnthly.CSV").Activate
        Columns("B:B").Select
    Selection.Copy
    Windows("LMacro.xlsm").Activate
    ws.Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveSheet.Range("$A$1:$A$60000").RemoveDuplicates Columns:=1, Header:= _
        xlNo

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    With ws
        'Change back to 100+
        For i = 2 To 5


            If ws.Range("A" & i).Value <> "" Then
            Sheets.Add(After:=Sheets(Worksheets.Count)).Name = ws.Range("A" & i).Value
            Set Fsheet = ActiveSheet
            Range("A1").Value = "Fund:"
            Range("B1").Value = Fsheet.Name
            Range("A2").Value = "Date:"
            Range("B2").Value = "=Xtract!R[-1]C"

            Windows("SecurityXtract_Mnthly.CSV").Activate
            Rows("1:1").Select
            Selection.Copy
            Windows("LMacro.xlsm").Activate
            Rows("4:4").Select
            ActiveSheet.Paste
            Selection.Font.Bold = True
            Application.CutCopyMode = False

            For j = 2 To XwsRows
                If Xws.Range("B" & j).Value = Fsheet.Range("B1") Then
                    Windows("SecurityXtract_Mnthly.CSV").Activate
                    Xws.Range("B" & j).Select
                    ActiveCell.EntireRow.Select
                    Selection.Copy
                    Windows("LMacro.xlsm").Activate
                    Fsheet.Range("A" & j + 3).EntireRow.Select
                    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
                    Application.CutCopyMode = False
                    Columns("A:A").Select
                    Selection.SpecialCells(xlCellTypeBlanks).Select
                    Selection.EntireRow.Delete

                End If
            Next j

            Range("C:D, F:F, I:BB, BD:BL, BP:BR, BT:BV, BX:CD, CF:CN, CP:DI").EntireColumn.Select
                    Selection.Delete Shift:=xlToLeft

            End If

                Cells.Select
                Cells.EntireColumn.AutoFit
                Range("A1").Select


        Next i
    End With

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True


 End Sub

Я также нашел этот код в другом вопросе, но я не уверен, что его можно применить, так как я использую две разные книги. Этот код:

 If Range("S1").Offset(i) > 0.005 Then
            Range("AC").Offset(i).Resize(1, 2).Value = Range("Z").Offset(i).Resize(1, 2).Value
    End If

Заменено это:

If Range("S" & i) > 0.005 Then
        Range("Z" & i, "AA" & i).Copy
        Range("AC" & i, "AD" & i).PasteSpecial xlPasteValues
End If

Полная ссылка на этот код / вопрос, на который я ссылаюсь здесь:Предложения по ускорению цикла

Заранее спасибо за любую помощь, которую вы можете оказать :)

Ответы на вопрос(2)

Ваш ответ на вопрос