Ускорение времени выполнения в макросе 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
Полная ссылка на этот код / вопрос, на который я ссылаюсь здесь:Предложения по ускорению цикла
Заранее спасибо за любую помощь, которую вы можете оказать :)