View Full Version : [SOLVED:] For loop very bad performance
Hello,
I am matching about 22,000 IDs with a 55,000 row huge inventory. On hit I will check another column for a value and write down the findings in a third table.
My problem is, that this procedure will take more than 20 minutes (I canceled it there). Why is it taking so long and how can I improve the performance?
An exemplary table with code is enclosed, thanks in advance and regards
Bydo
Bob Phillips
05-11-2017, 05:48 AM
Try this
Public Sub FormatOutput()
Dim lastrow As Long
Application.ScreenUpdating = False
lastrow = Worksheets("Prüfliste").Range("A" & Rows.Count).End(xlUp).Row
With Worksheets("Ausgabe")
.Range("A2").Resize(lastrow - 1).FormulaR1C1 = "=Prüfliste!RC"
.Range("B2").Resize(lastrow - 1).Value = Format(Now, "DD.MM.YYYY HH:MM")
.Range("C2").Resize(lastrow - 1).Value = "bydo@vba.ms"
.Range("D2").Resize(lastrow - 1).Value = "bydo"
.Range("E2").Resize(lastrow - 1).FormulaR1C1 = _
"=IF(ISNA(MATCH(Prüfliste!RC[-3],Inventar!C[-2],0)),MATCH(Prüfliste!RC[-3],Inventar!C[-1],0),MATCH(Prüfliste!RC[-3],Inventar!C[-2],0))"
.Range("F2").Resize(lastrow - 1).FormulaR1C1 = _
"=IF(ISNA(RC5),""nicht gefunden"",IF(OR(INDEX(Inventar!C6,RC5)=""aktiv"",INDEX(Inventar!C6,RC5)=""wartend""),"""",INDEX(Inventar!C[-4],RC5)))"
.Range("G2").Resize(lastrow - 1).FormulaR1C1 = _
"=IF(ISNA(RC5),""nicht gefunden"",IF(OR(INDEX(Inventar!C6,RC5)=""aktiv"",INDEX(Inventar!C6,RC5)=""wartend""),"""",INDEX(Inventar!C[-2],RC5)))"
.Range("H2").Resize(lastrow - 1).FormulaR1C1 = _
"=IF(ISNA(RC5),""nicht gefunden"",IF(OR(INDEX(Inventar!C6,RC5)=""aktiv"",INDEX(Inventar!C6,RC5)=""wartend""),"""",INDEX(Inventar!C[-2],RC5)))"
With .Range("A2").Resize(lastrow - 1, 8)
.Value = .Value
End With
.Columns("E:E").Delete
End With
Application.ScreenUpdating = True
End Sub
The Code from your attachement:
Sub FORIFIF()
Dim CHECKROW As Long
Dim INVENTROW As Long
Dim OUTPUTROW As Long
Application.ScreenUpdating = False
OUTPUTROW = 1
For CHECKROW = Sheets("Prüfliste").Range("A" & Rows.Count).End(3)(1).Row To 2 Step -1
OUTPUTROW = OUTPUTROW + 1
Sheets("Ausgabe").Cells(OUTPUTROW, 1).Value = Sheets("Prüfliste").Cells(CHECKROW, 1).Value
Sheets("Ausgabe").Cells(OUTPUTROW, 2).Value = Format(Now, "DD.MM.YYYY HH:MM")
Sheets("Ausgabe").Cells(OUTPUTROW, 3).Value = "bydo@vba.ms"
Sheets("Ausgabe").Cells(OUTPUTROW, 4).Value = "bydo"
For INVENTROW = Sheets("Inventar").Range("A" & Rows.Count).End(3)(1).Row To 2 Step -1
If Sheets("Inventar").Cells(INVENTROW, 3).Value = Sheets("Prüfliste").Cells(CHECKROW, 2).Value Then
If Sheets("Inventar").Cells(INVENTROW, 6).Value = "aktiv" Or Sheets("Inventar").Cells(INVENTROW, 6).Value = "wartend" Then
Exit For
Else
Sheets("Ausgabe").Cells(OUTPUTROW, 5).Value = Sheets("Inventar").Cells(INVENTROW, 2).Value
Sheets("Ausgabe").Cells(OUTPUTROW, 6).Value = Sheets("Inventar").Cells(INVENTROW, 5).Value
Sheets("Ausgabe").Cells(OUTPUTROW, 7).Value = Sheets("Inventar").Cells(INVENTROW, 6).Value
Exit For
End If
End If
If Sheets("Inventar").Cells(INVENTROW, 4).Value = Sheets("Prüfliste").Cells(CHECKROW, 2).Value Then
If Sheets("Inventar").Cells(INVENTROW, 6).Value = "aktiv" Or Sheets("Inventar").Cells(INVENTROW, 6).Value = "wartend" Then
Exit For
Else
Sheets("Ausgabe").Cells(OUTPUTROW, 5).Value = Sheets("Inventar").Cells(INVENTROW, 2).Value
Sheets("Ausgabe").Cells(OUTPUTROW, 6).Value = Sheets("Inventar").Cells(INVENTROW, 5).Value
Sheets("Ausgabe").Cells(OUTPUTROW, 7).Value = Sheets("Inventar").Cells(INVENTROW, 6).Value
Exit For
End If
End If
If INVENTROW = 2 Then
Sheets("Ausgabe").Cells(OUTPUTROW, 5).Value = "nicht gefunden"
Sheets("Ausgabe").Cells(OUTPUTROW, 6).Value = "nicht gefunden"
Sheets("Ausgabe").Cells(OUTPUTROW, 7).Value = "nicht gefunden"
End If
Next INVENTROW
Next CHECKROW
Application.ScreenUpdating = True
End Sub
I think we can make that 5500 times faster
Here's what I came up with
Sub FORIFIF()
Dim CheckRow As Long
Dim OutRow As Long
Dim Ausgabe As Object
Dim Inventar As Object
Dim Prüfliste As Object
Dim InventCallSigns As Range
Dim Found As Range
Set Prüfliste = Sheets("Prüfliste")
Set Inventar = Sheets("Inventar")
Set Ausgabe = Sheets("Ausgabe")
Set InventCallSigns = Inventar.Range("C:D")
OutRow = 1
Application.ScreenUpdating = False
For CheckRow = Prüfliste.Range("A" & Rows.Count).End(3)(1).Row To 2 Step -1
Ausgabe.Cells(OutRow, 1).Value = Prüfliste.Cells(CheckRow, 1).Value
Ausgabe.Cells(OutRow, 2).Value = Format(Now, "DD.MM.YYYY HH:MM")
Ausgabe.Cells(OutRow, 3).Value = "bydo@vba.ms"
Ausgabe.Cells(OutRow, 4).Value = "bydo"
OutRow = OutRow + 1
Set Found = InventCallSigns.Find(Prüfliste.Cells(CheckRow, 2))
If Found Is Nothing Then
Ausgabe.Cells(OutRow, 5).Value = "nicht gefunden"
Ausgabe.Cells(OutRow, 6).Value = "nicht gefunden"
Ausgabe.Cells(OutRow, 7).Value = "nicht gefunden"
Else
With Inventar.Rows(Found.Row)
If .Cells(6) <> "aktiv" And .Cells(6) <> "wartend" Then
Ausgabe.Cells(OutRow, 5).Value = .Cells(2).Value
Ausgabe.Cells(OutRow, 6).Value = .Cells(5).Value
Ausgabe.Cells(OutRow, 7).Value = .Cells(6).Value
End If
End With
End If
Next CheckRow
Application.ScreenUpdating = True
End Sub
oder:
Sub M_snb()
sn = Sheets("inventar").Cells(1).CurrentRegion
sp = Sheets("prüfliste").Cells(1).CurrentRegion
Set d_01 = CreateObject("scripting.dictionary")
With CreateObject("scripting.dictionary")
For j = 2 To UBound(sn)
x0 = .Item(sn(j, 4))
Next
For j = 2 To UBound(sp)
If .exists(sp(j, 2)) Then d_01.Item(sp(j, 1)) = Array(sp(j, 1), Format(Now, "DD.MM.YYYY HH:MM"), "bydo@vba.ms", "bydo")
Next
End With
If d_01.Count > 0 Then Sheets("ausgabe").Cells(2, 1).Resize(d_01.Count, 4) = Application.Index(d_01.items, 0, 0)
End Sub
Outstanding work xld,
The final result clocked in at 2 minutes 30 seconds, thanks a lot for your help!!
Mind if you tell me why your method is so much faster? What did you actually do?
Thanks a lot for your input also SamT,
your code took 8 minutes to work the lists!
Crossposted in ca. 20 Fora:
http://www.clever-excel-forum.de/Thread-VBA-For-Schleife-Performanceprobleme?pid=80109#pid80109
Zack Barresse
05-11-2017, 07:51 AM
bydo, please read this.
http://www.excelguru.ca/content.php?184
There are ways to cross-post, and there are ways to not. Please do not waste our members time.
Bob Phillips
05-11-2017, 03:42 PM
Outstanding work xld,
The final result clocked in at 2 minutes 30 seconds, thanks a lot for your help!!
Mind if you tell me why your method is so much faster? What did you actually do?
My approach was to remove all of the loops, which is what takes all of the time. Instead, I setup each column with formulae that emulated your VBA logic. I then did a copy-pastevalues of them all. I did insert a column that you didn't want to get the row n umber which I used within those formulae, so I had to delete that at the end.
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.