VBA For Schleife Performanceprobleme

[Bydo]

Hallo zusammen,

ich habe eine Tabelle mit 22.000 Ids, welche ich in einer 55.000 Zeilen großen Bestandstabelle Suche und bei Treffer einen Wert in einer Nachbarspalte überprüfe. Je nach Zusammenstellung wird etwas in eine dritte Tabelle ausgespeichert.

Mein Problem: Dieser Vorgang dauer 20 Minuten+ (ich habe den Prozess an dieser Stelle beendet). Wieso braucht der Rechner so lange und wie kann ich die Arbeit zügiger erledigen lassen?

Beispieltabelle mit Code liegt anbei, vorab vielen Dank und viele Grüße

Bydo

Ebenfalls gefragt auf:
http://www.ms-office-forum.net/forum/sho...p?t=342528
http://www.herber.de/forum/messages/1557784.html

[Steffl]

Hallo,

was soll das

Code:

.End(3)(1).Row

bezwecken?

[Bydo]

Ermittelt meines Wissens nach die letzte befüllte Zeile!?

[Fennek]

Hallo Bydo,

wenn man Arrays, eventuell auch Dictionary, nutzt, sollte eine Laufzeit unter 5 Sekunden möglich sein.

Bei der ersten 1-Minuten Sichtung konnte ich nicht erkennen, was gesucht und verglichen werden soll. Aber das kannst du noch erklären.

mfg

[steve1da]

Hola,

verlinkst du bitte deine Fragen in den verschiedenen Foren gegenseitig?
Danke.

Gruß,
steve1da

[Bydo]

Hallo Fennek,

die Werte aus der Tabelle "Prüfliste" Spalte B sollen in der Tabelle "Inventar" in den Spalten C und D gesucht werden. Bei Treffer wird Spalte F auf die Werte "aktiv" oder "wartend" überprüft.

[Bydo]

Hallo steve1da, verstehe deine Bitte nicht, meinst du damit sofern ich eine Antwort auf einer der Platformen erhalte, diese auf den anderen Platformen ersichtlich ist?

[Steffl]

Hallo,

teste mal

Code:

Sub FORIFIF()
Dim CHECKROW As Long
Dim INVENTROW As Long
Dim OUTPUTROW As Long
Dim rngTreffer As Range

Application.ScreenUpdating = False

OUTPUTROW = 1

   For CHECKROW = Sheets("Prüfliste").Range("A" & Rows.Count).End(xlUp).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"
           
           Set rngTreffer = Sheets("Inventar").Columns(3).Resize(, 2).Find(Sheets("Prüfliste").Cells(CHECKROW, 2).Value, LookIn:=xlValue, lookat:=xlWhole, SearchOrder:=xlByRows)
           If Not rngTreffer Is Nothing Then
               If Sheets("Inventar").Cells(rngTreffer.Row, 3).Value = "aktiv" Or Sheets("Inventar").Cells(rngTreffer.Row, 6).Value = "wartend" Then
               Else
                   Sheets("Ausgabe").Cells(OUTPUTROW, 5).Value = Sheets("Inventar").Cells(rngTreffer.Row, 2).Value
                   Sheets("Ausgabe").Cells(OUTPUTROW, 6).Value = Sheets("Inventar").Cells(rngTreffer.Row, 5).Value
                   Sheets("Ausgabe").Cells(OUTPUTROW, 7).Value = Sheets("Inventar").Cells(rngTreffer.Row, 6).Value
               End If
           Else
               Sheets("Ausgabe").Cells(OUTPUTROW, 5).Resize(,3).Value = "nicht gefunden"
           End If
           
'            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

[steve1da]

Hola,

du schreibst hier, wo du noch gefragt hast und umgekehrt. Somit wird unnötige Doppelarbeit vermieden.

Gruß,
steve1da

[Bydo]

Hallo Stefan, "index außerhalb des gültigen Bereichs" nach der ersten  bearbeiteten Zeile