Beschleunigung der Laufzeit in VBA Excel-Makro mit Doppelschleife

Ich habe tatsächlich einen funktionierenden Code, obwohl die Ausführung mit der Datenmenge und der Art und Weise, wie ich den Code geschrieben habe, über eine Stunde dauert und ich noch eine ganze Menge Code hinzufügen muss, um die Daten tatsächlich zu analysieren. Ich verwende eine Doppelschleife, und bevor ich screenupdating = false hinzufügte, schien es, als würde die im Inneren verschachtelte Schleife so lange dauern.

Folgendes habe ich:

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

Ich habe diesen Code auch bei einer anderen Frage gefunden, bin mir aber nicht sicher, ob er angewendet werden kann, da ich zwei verschiedene Arbeitsmappen verwende. Dieser Code:

 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

Ersetzt dies:

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

Der vollständige Link zu diesem Code / Frage, auf den ich hier verweise, lautet:Vorschläge zur Beschleunigung der Schleife

Vielen Dank im Voraus für jede Hilfe, die Sie geben können :)

Antworten auf die Frage(2)

Ihre Antwort auf die Frage