Acelerando o tempo de execução no VBA excel macro com loop duplo
Na verdade, tenho algum código em funcionamento, embora com a quantidade de dados que tenho e a maneira como escrevi o código, demora mais de uma hora para ser executado e ainda preciso adicionar um pouco de código para analisar os dados. Eu estou usando um loop duplo, e antes de adicionar o screenupdating = false, parecia que o loop aninhado no interior era o que estava demorando tanto.
Aqui está o que eu tenho:
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
Eu também encontrei este código em outra pergunta, mas não tenho certeza se ele pode ser aplicado desde que eu estou usando duas pastas de trabalho diferentes. Este código:
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
Substituído isto:
If Range("S" & i) > 0.005 Then
Range("Z" & i, "AA" & i).Copy
Range("AC" & i, "AD" & i).PasteSpecial xlPasteValues
End If
O link completo deste código / questão que eu faço referência aqui é:Sugestões sobre como acelerar o loop
Agradecemos antecipadamente por qualquer ajuda que você pode dar :)