Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 21:40:53
Excel Datenquelle aus dem Web mit Anmeldung?
25.04.2024 21:21:16
Zellkommentar in UserForm anzeigen und bearbeiten
25.04.2024 21:13:13
Kalenderwochen addieren
25.04.2024 21:06:05
Duplikate entfernen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1492to1496
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1492to1496
1492to1496
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Optimierung der Makro-Durchlaufzeit

Optimierung der Makro-Durchlaufzeit
16.05.2016 14:23:47
Bjoern

Hallo zusammen,
ich habe eine Frage an alle VBA-Experten. Ich habe ein Makro geschrieben, das eine For/Next-Schleife b einhaltet. Mit dieser Schleife sollen bis zu 1700 Zeilen eines Tabellenblatts auf bestimmte Inhalte überprüft und in einem anderen Tabellenblatt geschrieben werden. Diese Schleife läuft mit einem leistungsstarken Rechner ca. 2,5 Stunden. Ich gehe sehr stark davon aus, dass man die Durchlaufzeit deutlich reduzieren kann, da ich das Makro sehr einfach geschrieben habe.
Könnt Ihr mir Oprimierungspotentiale für dieses Makro aufzeigen. Ich muss unbedingt von der langen Durchlaufzeit weg...
Hier nochmal eine kleine Beschreibung zur Funktionsweise:
1. Im Tabellenblatt "Basis" wird zeilenweise die Spalte H (Bereiche) ausgelesen und der Inhalt gespeichert.
2. Das Makro wechselt zum Tabellenblatt "Aufbereitung" und sucht in Spalte B die Zeile mit dem Inhalt des abgespeicherten Textbausteins vom Tabellenblatt "Basis"
3. Nachdem die Zeile gefunden wurde, wird die nächste, leere Zelle dieser Zeile gesucht und die Start, und Endzeit aus dem Tabellenblatt "Basis" kopiert und in die leere Zelle geschrieben (Startzeit in die Spalte Beginn und die Endzeit in die Spalte Ende).
4. Sollte in einer Zeile bereits Start- und Endzeiten eines Vorgängerprozesses gelistet sein, wird überprüft, ob die Endzeit der Vorgängerprozesses <= der zu schreibenden Startzeit ist. Wenn nicht, dann wird die Startzeit in die nachste Zeile des jeweiligen Bereichs (Parallelprozess) geschrieben.
Hier mein Code: 


Sub drei_ProzesszeitenSchreiben()
'Anzahl Zeilen ermitteln
Dim lngLastRow, lngDurchgang, lngStartzeit, lngEndzeit, lngLetzteSpalteRow1,  _
lngLetzteSpalteRow2, lngLetzteSpalteRow3, lngLetzteSpalteRow4, lngLetzteSpalteRow5,  _
lngLetzteSpalteRow6, lngLetzteSpalteRow7, lngZeile, lngRow As Long
Dim strBereichPosition As String
Dim lnglast As Long
Dim lngZ As Long
Dim strSuchBereich
'Dim wksA, wksB As Worksheet
'Bereinigung des Layouts von Altdaten
Sheets("Aufbereitung").Range("E3:AV289").ClearContents
Sheets("Aufbereitung").Range("E3:AV289").Interior.ColorIndex = 2
'Anzahl beschriebener Zeilen ermitteln
With ThisWorkbook.Worksheets("Basis")
lngLastRow = IIf(Len(.Cells(.Rows.Count, 1)), .Rows.Count, .Cells(.Rows.Count, 1).End(xlUp). _
_
Row)
End With
'Screenupdate
Application.ScreenUpdating = False
'For/Next-Schleife start
For lngDurchgang = 2 To 10 'lngLastRow
'Variablen im Tabellenblatt Basis suchen und merken
lngStartzeit = Sheets("Basis").Cells(lngDurchgang, 7)     'Startzeit (Prozess)
lngEndzeit = Sheets("Basis").Cells(lngDurchgang, 5)       'Endzeit (Prozess)
strBereichPosition = Sheets("Basis").Cells(lngDurchgang, 8)  'Bereich (an dem gearbeitet  _
wird)
'im Tabellenblatt Aufbereitung den Wert "Spantbereich" suchen
strSuchBereich = strBereichPosition                                         ' _
strSuchBereich der Zeilennummer
lnglast = Worksheets("Aufbereitung").Cells(Rows.Count, 3).Row      'Ermittelt die  _
Zeilenanzahl beschriebener Zeilen (Anzahl Zeilen ermitteln)
With Worksheets("Aufbereitung")
For lngZ = 3 To lnglast
If .Cells(lngZ, 2).Value = strBereichPosition Then                     'Suche nach der  _
_
geforderten Bereich, Zeilennummer wird gespeichert
lngRow = Cells(lngZ, 1).Row
lngZeile = Cells(lngZ, 1).Row
End If
Next
End With
'letzte beschriebene Spalte eritteln
lngLetzteSpalteRow1 = Worksheets("Aufbereitung").Cells(lngRow, Columns.Count).End(xlToLeft). _
_
Column
lngLetzteSpalteRow2 = Worksheets("Aufbereitung").Cells(lngRow + 1, Columns.Count).End( _
xlToLeft).Column
lngLetzteSpalteRow3 = Worksheets("Aufbereitung").Cells(lngRow + 2, Columns.Count).End( _
xlToLeft).Column
lngLetzteSpalteRow4 = Worksheets("Aufbereitung").Cells(lngRow + 3, Columns.Count).End( _
xlToLeft).Column
lngLetzteSpalteRow5 = Worksheets("Aufbereitung").Cells(lngRow + 4, Columns.Count).End( _
xlToLeft).Column
lngLetzteSpalteRow6 = Worksheets("Aufbereitung").Cells(lngRow + 5, Columns.Count).End( _
xlToLeft).Column
lngLetzteSpalteRow7 = Worksheets("Aufbereitung").Cells(lngRow + 6, Columns.Count).End( _
xlToLeft).Column
'Werte vergleichen und in Tabellenblatt Aufbereitung einfügen
'Set wksA = Worksheets("Aufbereitung")
'Set wksB = Worksheets("Basis")
'Zeile 1
If Worksheets("Aufbereitung").Cells(lngZeile, lngLetzteSpalteRow1) <= lngStartzeit Then      _
_
'Start- Endzeiten der Prozesse auf Bereichsebene schreiben - Zeile 1
lngStartzeit = Sheets("Basis").Cells(lngDurchgang, 7).Copy
Worksheets("Aufbereitung").Cells(lngZeile, lngLetzteSpalteRow1 + 1).PasteSpecial Paste:= _
xlPasteValues
lngEndzeit = Sheets("Basis").Cells(lngDurchgang, 5).Copy
Worksheets("Aufbereitung").Cells(lngZeile, lngLetzteSpalteRow1 + 2).PasteSpecial Paste:= _
xlPasteValues
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*Tätigkeit.1*" Then
Worksheets("Aufbereitung").Cells(lngZeile, lngLetzteSpalteRow1 + 1).Interior.ColorIndex  _
_
= 33
Worksheets("Aufbereitung").Cells(lngZeile, lngLetzteSpalteRow1 + 2).Interior.ColorIndex  _
_
= 33
End If
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*Tätigkeit.2*" Then
Worksheets("Aufbereitung").Cells(lngZeile, lngLetzteSpalteRow1 + 1).Interior.ColorIndex  _
_
= 46
Worksheets("Aufbereitung").Cells(lngZeile, lngLetzteSpalteRow1 + 2).Interior.ColorIndex  _
_
= 46
End If
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*Tätigkeit.3*" Then
Worksheets("Aufbereitung").Cells(lngZeile, lngLetzteSpalteRow1 + 1).Interior.ColorIndex  _
_
= 44
Worksheets("Aufbereitung").Cells(lngZeile, lngLetzteSpalteRow1 + 2).Interior.ColorIndex  _
_
= 44
End If
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*DeTätigkeit.1*" Then
Worksheets("Aufbereitung").Cells(lngZeile, lngLetzteSpalteRow1 + 1).Interior.ColorIndex  _
_
= 32
Worksheets("Aufbereitung").Cells(lngZeile, lngLetzteSpalteRow1 + 2).Interior.ColorIndex  _
_
= 32
End If
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*Tätigkeit.5*" Then
Worksheets("Aufbereitung").Cells(lngZeile, lngLetzteSpalteRow1 + 1).Interior.ColorIndex  _
_
= 27
Worksheets("Aufbereitung").Cells(lngZeile, lngLetzteSpalteRow1 + 2).Interior.ColorIndex  _
_
= 27
End If
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*Tätigkeit.6 Struktur*" Then
Worksheets("Aufbereitung").Cells(lngZeile, lngLetzteSpalteRow1 + 1).Interior.ColorIndex  _
_
= 26
Worksheets("Aufbereitung").Cells(lngZeile, lngLetzteSpalteRow1 + 2).Interior.ColorIndex  _
_
= 26
End If
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*Tätigkeit.7*" Then
Worksheets("Aufbereitung").Cells(lngZeile, lngLetzteSpalteRow1 + 1).Interior.ColorIndex  _
_
= 36
Worksheets("Aufbereitung").Cells(lngZeile, lngLetzteSpalteRow1 + 2).Interior.ColorIndex  _
_
= 36
End If
'Zeile 2
ElseIf Worksheets("Aufbereitung").Cells(lngZeile + 1, lngLetzteSpalteRow2) <= lngStartzeit   _
_
Then       'Start- Endzeiten der prozesse auf Bereichsebene schreiben - Zeile 2
lngStartzeit = Sheets("Basis").Cells(lngDurchgang, 7).Copy
Worksheets("Aufbereitung").Cells(lngZeile + 1, lngLetzteSpalteRow2 + 1).PasteSpecial Paste:= _
_
xlPasteValues
lngEndzeit = Sheets("Basis").Cells(lngDurchgang, 5).Copy
Worksheets("Aufbereitung").Cells(lngZeile + 1, lngLetzteSpalteRow2 + 2).PasteSpecial Paste:= _
_
xlPasteValues
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*Tätigkeit.1*" Then
Worksheets("Aufbereitung").Cells(lngZeile + 1, lngLetzteSpalteRow2 + 1).Interior. _
ColorIndex = 33
Worksheets("Aufbereitung").Cells(lngZeile + 1, lngLetzteSpalteRow2 + 2).Interior. _
ColorIndex = 33
End If
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*Tätigkeit.2*" Then
Worksheets("Aufbereitung").Cells(lngZeile + 1, lngLetzteSpalteRow2 + 1).Interior. _
ColorIndex = 46
Worksheets("Aufbereitung").Cells(lngZeile + 1, lngLetzteSpalteRow2 + 2).Interior. _
ColorIndex = 46
End If
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*Tätigkeit.3*" Then
Worksheets("Aufbereitung").Cells(lngZeile + 1, lngLetzteSpalteRow2 + 1).Interior. _
ColorIndex = 44
Worksheets("Aufbereitung").Cells(lngZeile + 1, lngLetzteSpalteRow2 + 2).Interior. _
ColorIndex = 44
End If
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*DeTätigkeit.1*" Then
Worksheets("Aufbereitung").Cells(lngZeile + 1, lngLetzteSpalteRow2 + 1).Interior. _
ColorIndex = 32
Worksheets("Aufbereitung").Cells(lngZeile + 1, lngLetzteSpalteRow2 + 2).Interior. _
ColorIndex = 32
End If
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*Tätigkeit.5*" Then
Worksheets("Aufbereitung").Cells(lngZeile + 1, lngLetzteSpalteRow2 + 1).Interior. _
ColorIndex = 27
Worksheets("Aufbereitung").Cells(lngZeile + 1, lngLetzteSpalteRow2 + 2).Interior. _
ColorIndex = 27
End If
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*Tätigkeit.6 Struktur*" Then
Worksheets("Aufbereitung").Cells(lngZeile + 1, lngLetzteSpalteRow2 + 1).Interior. _
ColorIndex = 26
Worksheets("Aufbereitung").Cells(lngZeile + 1, lngLetzteSpalteRow2 + 2).Interior. _
ColorIndex = 26
End If
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*Tätigkeit.7*" Then
Worksheets("Aufbereitung").Cells(lngZeile + 1, lngLetzteSpalteRow2 + 1).Interior. _
ColorIndex = 36
Worksheets("Aufbereitung").Cells(lngZeile + 1, lngLetzteSpalteRow2 + 2).Interior. _
ColorIndex = 36
End If
'Zeile 3
ElseIf Worksheets("Aufbereitung").Cells(lngZeile + 2, lngLetzteSpalteRow3) <= lngStartzeit   _
_
Then       'Start- Endzeiten der Prozesse auf Bereichsebene schreiben - Zeile 3
lngStartzeit = Sheets("Basis").Cells(lngDurchgang, 7).Copy
Worksheets("Aufbereitung").Cells(lngZeile + 2, lngLetzteSpalteRow3 + 1).PasteSpecial Paste:= _
_
xlPasteValues
lngEndzeit = Sheets("Basis").Cells(lngDurchgang, 5).Copy
Worksheets("Aufbereitung").Cells(lngZeile + 2, lngLetzteSpalteRow3 + 2).PasteSpecial Paste:= _
_
xlPasteValues
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*Tätigkeit.1*" Then
Worksheets("Aufbereitung").Cells(lngZeile + 2, lngLetzteSpalteRow3 + 1).Interior. _
ColorIndex = 33
Worksheets("Aufbereitung").Cells(lngZeile + 2, lngLetzteSpalteRow3 + 2).Interior. _
ColorIndex = 33
End If
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*Tätigkeit.2*" Then
Worksheets("Aufbereitung").Cells(lngZeile + 2, lngLetzteSpalteRow3 + 1).Interior. _
ColorIndex = 46
Worksheets("Aufbereitung").Cells(lngZeile + 2, lngLetzteSpalteRow3 + 2).Interior. _
ColorIndex = 46
End If
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*Tätigkeit.3*" Then
Worksheets("Aufbereitung").Cells(lngZeile + 2, lngLetzteSpalteRow3 + 1).Interior. _
ColorIndex = 44
Worksheets("Aufbereitung").Cells(lngZeile + 2, lngLetzteSpalteRow3 + 2).Interior. _
ColorIndex = 44
End If
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*DeTätigkeit.1*" Then
Worksheets("Aufbereitung").Cells(lngZeile + 2, lngLetzteSpalteRow3 + 1).Interior. _
ColorIndex = 32
Worksheets("Aufbereitung").Cells(lngZeile + 2, lngLetzteSpalteRow3 + 2).Interior. _
ColorIndex = 32
End If
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*Tätigkeit.5*" Then
Worksheets("Aufbereitung").Cells(lngZeile + 2, lngLetzteSpalteRow3 + 1).Interior. _
ColorIndex = 27
Worksheets("Aufbereitung").Cells(lngZeile + 2, lngLetzteSpalteRow3 + 2).Interior. _
ColorIndex = 27
End If
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*Tätigkeit.6 Struktur*" Then
Worksheets("Aufbereitung").Cells(lngZeile + 2, lngLetzteSpalteRow3 + 1).Interior. _
ColorIndex = 26
Worksheets("Aufbereitung").Cells(lngZeile + 2, lngLetzteSpalteRow3 + 2).Interior. _
ColorIndex = 26
End If
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*Tätigkeit.7*" Then
Worksheets("Aufbereitung").Cells(lngZeile + 2, lngLetzteSpalteRow3 + 1).Interior. _
ColorIndex = 36
Worksheets("Aufbereitung").Cells(lngZeile + 2, lngLetzteSpalteRow3 + 2).Interior. _
ColorIndex = 36
End If
'Zeile 4
ElseIf Worksheets("Aufbereitung").Cells(lngZeile + 3, lngLetzteSpalteRow4) <= lngStartzeit   _
_
Then       'Start- Endzeiten der Prozesse auf Bereichsebene schreiben - Zeile 4
lngStartzeit = Sheets("Basis").Cells(lngDurchgang, 7).Copy
Worksheets("Aufbereitung").Cells(lngZeile + 3, lngLetzteSpalteRow4 + 1).PasteSpecial Paste:= _
_
xlPasteValues
lngEndzeit = Sheets("Basis").Cells(lngDurchgang, 5).Copy
Worksheets("Aufbereitung").Cells(lngZeile + 3, lngLetzteSpalteRow4 + 2).PasteSpecial Paste:= _
_
xlPasteValues
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*Tätigkeit.1*" Then
Worksheets("Aufbereitung").Cells(lngZeile + 3, lngLetzteSpalteRow4 + 1).Interior. _
ColorIndex = 33
Worksheets("Aufbereitung").Cells(lngZeile + 3, lngLetzteSpalteRow4 + 2).Interior. _
ColorIndex = 33
End If
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*Tätigkeit.2*" Then
Worksheets("Aufbereitung").Cells(lngZeile + 3, lngLetzteSpalteRow4 + 1).Interior. _
ColorIndex = 46
Worksheets("Aufbereitung").Cells(lngZeile + 3, lngLetzteSpalteRow4 + 2).Interior. _
ColorIndex = 46
End If
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*Tätigkeit.3*" Then
Worksheets("Aufbereitung").Cells(lngZeile + 3, lngLetzteSpalteRow4 + 1).Interior. _
ColorIndex = 44
Worksheets("Aufbereitung").Cells(lngZeile + 3, lngLetzteSpalteRow4 + 2).Interior. _
ColorIndex = 44
End If
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*DeTätigkeit.1*" Then
Worksheets("Aufbereitung").Cells(lngZeile + 3, lngLetzteSpalteRow4 + 1).Interior. _
ColorIndex = 32
Worksheets("Aufbereitung").Cells(lngZeile + 3, lngLetzteSpalteRow4 + 2).Interior. _
ColorIndex = 32
End If
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*Tätigkeit.5*" Then
Worksheets("Aufbereitung").Cells(lngZeile + 3, lngLetzteSpalteRow4 + 1).Interior. _
ColorIndex = 27
Worksheets("Aufbereitung").Cells(lngZeile + 3, lngLetzteSpalteRow4 + 2).Interior. _
ColorIndex = 27
End If
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*Tätigkeit.6 Struktur*" Then
Worksheets("Aufbereitung").Cells(lngZeile + 3, lngLetzteSpalteRow4 + 1).Interior. _
ColorIndex = 26
Worksheets("Aufbereitung").Cells(lngZeile + 3, lngLetzteSpalteRow4 + 2).Interior. _
ColorIndex = 26
End If
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*Tätigkeit.7*" Then
Worksheets("Aufbereitung").Cells(lngZeile + 3, lngLetzteSpalteRow4 + 1).Interior. _
ColorIndex = 36
Worksheets("Aufbereitung").Cells(lngZeile + 3, lngLetzteSpalteRow4 + 2).Interior. _
ColorIndex = 36
End If
'Zeile 5
ElseIf Worksheets("Aufbereitung").Cells(lngZeile + 4, lngLetzteSpalteRow5) <= lngStartzeit   _
_
Then       'Start- Endzeiten der Prozesse auf Bereichsebene schreiben - Zeile 5
lngStartzeit = Sheets("Basis").Cells(lngDurchgang, 7).Copy
Worksheets("Aufbereitung").Cells(lngZeile + 4, lngLetzteSpalteRow5 + 1).PasteSpecial Paste:= _
_
xlPasteValues
lngEndzeit = Sheets("Basis").Cells(lngDurchgang, 5).Copy
Worksheets("Aufbereitung").Cells(lngZeile + 4, lngLetzteSpalteRow5 + 2).PasteSpecial Paste:= _
_
xlPasteValues
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*Tätigkeit.1*" Then
Worksheets("Aufbereitung").Cells(lngZeile + 4, lngLetzteSpalteRow5 + 1).Interior. _
ColorIndex = 33
Worksheets("Aufbereitung").Cells(lngZeile + 4, lngLetzteSpalteRow5 + 2).Interior. _
ColorIndex = 33
End If
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*Tätigkeit.2*" Then
Worksheets("Aufbereitung").Cells(lngZeile + 4, lngLetzteSpalteRow5 + 1).Interior. _
ColorIndex = 46
Worksheets("Aufbereitung").Cells(lngZeile + 4, lngLetzteSpalteRow5 + 2).Interior. _
ColorIndex = 46
End If
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*Tätigkeit.3*" Then
Worksheets("Aufbereitung").Cells(lngZeile + 4, lngLetzteSpalteRow5 + 1).Interior. _
ColorIndex = 44
Worksheets("Aufbereitung").Cells(lngZeile + 4, lngLetzteSpalteRow5 + 2).Interior. _
ColorIndex = 44
End If
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*DeTätigkeit.1*" Then
Worksheets("Aufbereitung").Cells(lngZeile + 4, lngLetzteSpalteRow5 + 1).Interior. _
ColorIndex = 32
Worksheets("Aufbereitung").Cells(lngZeile + 4, lngLetzteSpalteRow5 + 2).Interior. _
ColorIndex = 32
End If
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*Tätigkeit.5*" Then
Worksheets("Aufbereitung").Cells(lngZeile, lngLetzteSpalteRow5 + 1).Interior.ColorIndex  _
_
= 27
Worksheets("Aufbereitung").Cells(lngZeile, lngLetzteSpalteRow5 + 2).Interior.ColorIndex  _
_
= 27
End If
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*Tätigkeit.6 Struktur*" Then
Worksheets("Aufbereitung").Cells(lngZeile + 4, lngLetzteSpalteRow5 + 1).Interior. _
ColorIndex = 26
Worksheets("Aufbereitung").Cells(lngZeile + 4, lngLetzteSpalteRow5 + 2).Interior. _
ColorIndex = 26
End If
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*Tätigkeit.7*" Then
Worksheets("Aufbereitung").Cells(lngZeile + 4, lngLetzteSpalteRow5 + 1).Interior. _
ColorIndex = 36
Worksheets("Aufbereitung").Cells(lngZeile + 4, lngLetzteSpalteRow5 + 2).Interior. _
ColorIndex = 36
End If
'Zeile 6
ElseIf Worksheets("Aufbereitung").Cells(lngZeile + 5, lngLetzteSpalteRow6) <= lngStartzeit   _
_
Then       'Start- Endzeiten der Prozesse auf Bereichsebene schreiben - Zeile 6
lngStartzeit = Sheets("Basis").Cells(lngDurchgang, 7).Copy
Worksheets("Aufbereitung").Cells(lngZeile + 5, lngLetzteSpalteRow6 + 1).PasteSpecial Paste:= _
_
xlPasteValues
lngEndzeit = Sheets("Basis").Cells(lngDurchgang, 5).Copy
Worksheets("Aufbereitung").Cells(lngZeile + 5, lngLetzteSpalteRow6 + 2).PasteSpecial Paste:= _
_
xlPasteValues
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*Tätigkeit.1*" Then
Worksheets("Aufbereitung").Cells(lngZeile + 5, lngLetzteSpalteRow6 + 1).Interior. _
ColorIndex = 33
Worksheets("Aufbereitung").Cells(lngZeile + 5, lngLetzteSpalteRow6 + 2).Interior. _
ColorIndex = 33
End If
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*Tätigkeit.2*" Then
Worksheets("Aufbereitung").Cells(lngZeile + 5, lngLetzteSpalteRow6 + 1).Interior. _
ColorIndex = 46
Worksheets("Aufbereitung").Cells(lngZeile + 5, lngLetzteSpalteRow6 + 2).Interior. _
ColorIndex = 46
End If
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*Tätigkeit.3*" Then
Worksheets("Aufbereitung").Cells(lngZeile + 5, lngLetzteSpalteRow6 + 1).Interior. _
ColorIndex = 44
Worksheets("Aufbereitung").Cells(lngZeile + 5, lngLetzteSpalteRow6 + 2).Interior. _
ColorIndex = 44
End If
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*DeTätigkeit.1*" Then
Worksheets("Aufbereitung").Cells(lngZeile + 5, lngLetzteSpalteRow6 + 1).Interior. _
ColorIndex = 32
Worksheets("Aufbereitung").Cells(lngZeile + 5, lngLetzteSpalteRow6 + 2).Interior. _
ColorIndex = 32
End If
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*Tätigkeit.5*" Then
Worksheets("Aufbereitung").Cells(lngZeile + 5, lngLetzteSpalteRow6 + 1).Interior. _
ColorIndex = 27
Worksheets("Aufbereitung").Cells(lngZeile + 5, lngLetzteSpalteRow6 + 2).Interior. _
ColorIndex = 27
End If
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*Tätigkeit.6 Struktur*" Then
Worksheets("Aufbereitung").Cells(lngZeile + 5, lngLetzteSpalteRow6 + 1).Interior. _
ColorIndex = 26
Worksheets("Aufbereitung").Cells(lngZeile + 5, lngLetzteSpalteRow6 + 2).Interior. _
ColorIndex = 26
End If
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*Tätigkeit.7*" Then
Worksheets("Aufbereitung").Cells(lngZeile + 5, lngLetzteSpalteRow6 + 1).Interior. _
ColorIndex = 36
Worksheets("Aufbereitung").Cells(lngZeile + 5, lngLetzteSpalteRow6 + 2).Interior. _
ColorIndex = 36
End If
'Zeile 7
ElseIf Worksheets("Aufbereitung").Cells(lngZeile + 6, lngLetzteSpalteRow7) <= lngStartzeit   _
_
Then       'Start- Endzeiten der Prozesse auf Bereichsebene schreiben - Zeile 7
lngStartzeit = Sheets("Basis").Cells(lngDurchgang, 7).Copy
Worksheets("Aufbereitung").Cells(lngZeile + 6, lngLetzteSpalteRow7 + 1).PasteSpecial Paste:= _
_
xlPasteValues
lngEndzeit = Sheets("Basis").Cells(lngDurchgang, 5).Copy
Worksheets("Aufbereitung").Cells(lngZeile + 6, lngLetzteSpalteRow7 + 2).PasteSpecial Paste:= _
_
xlPasteValues
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*Tätigkeit.1*" Then
Worksheets("Aufbereitung").Cells(lngZeile + 6, lngLetzteSpalteRow7 + 1).Interior. _
ColorIndex = 33
Worksheets("Aufbereitung").Cells(lngZeile + 6, lngLetzteSpalteRow7 + 2).Interior. _
ColorIndex = 33
End If
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*Tätigkeit.2*" Then
Worksheets("Aufbereitung").Cells(lngZeile + 6, lngLetzteSpalteRow7 + 1).Interior. _
ColorIndex = 46
Worksheets("Aufbereitung").Cells(lngZeile + 6, lngLetzteSpalteRow7 + 2).Interior. _
ColorIndex = 46
End If
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*Tätigkeit.3*" Then
Worksheets("Aufbereitung").Cells(lngZeile + 6, lngLetzteSpalteRow7 + 1).Interior. _
ColorIndex = 44
Worksheets("Aufbereitung").Cells(lngZeile + 6, lngLetzteSpalteRow7 + 2).Interior. _
ColorIndex = 44
End If
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*DeTätigkeit.1*" Then
Worksheets("Aufbereitung").Cells(lngZeile + 6, lngLetzteSpalteRow7 + 1).Interior. _
ColorIndex = 32
Worksheets("Aufbereitung").Cells(lngZeile + 6, lngLetzteSpalteRow7 + 2).Interior. _
ColorIndex = 32
End If
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*Tätigkeit.5*" Then
Worksheets("Aufbereitung").Cells(lngZeile + 6, lngLetzteSpalteRow7 + 1).Interior. _
ColorIndex = 27
Worksheets("Aufbereitung").Cells(lngZeile + 6, lngLetzteSpalteRow7 + 2).Interior. _
ColorIndex = 27
End If
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*Tätigkeit.6 Struktur*" Then
Worksheets("Aufbereitung").Cells(lngZeile + 6, lngLetzteSpalteRow7 + 1).Interior. _
ColorIndex = 26
Worksheets("Aufbereitung").Cells(lngZeile + 6, lngLetzteSpalteRow7 + 2).Interior. _
ColorIndex = 26
End If
If Worksheets("Basis").Cells(lngDurchgang, 13) Like "*Tätigkeit.7*" Then
Worksheets("Aufbereitung").Cells(lngZeile + 6, lngLetzteSpalteRow7 + 1).Interior. _
ColorIndex = 36
Worksheets("Aufbereitung").Cells(lngZeile + 6, lngLetzteSpalteRow7 + 2).Interior. _
ColorIndex = 36
End If
Else
MsgBox "Neue Zeile Für Spant [ " & strBereichPosition & "] einfügen"
End If
Next lngDurchgang
'Screenupdate
Application.ScreenUpdating = True
'Nachricht Makro Ende
MsgBox "Auswertung abgeschlossen !"
End Sub
https://www.herber.de/bbs/user/105587.xlsm
Grüße

13
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Optimierung der Makro-Durchlaufzeit
16.05.2016 14:35:07
Fennek
Hallo,
versuche

application.calculation = xlCalculationManual
und am Ende des Codes zurücksetzen mit
application.calculation = xlCalculationAutomatic
mfg

AW: Optimierung der Makro-Durchlaufzeit
16.05.2016 14:42:45
Bjoern
Hallo Fennek,
Danke für die schnelle Antwort.
Ich habe Deinen Vorschlag wie folgt eingebaut:
sub xyz()
dim yx as long
application.calculation = xlCalculationManual
for/next-schleife
application.calculation = xlCalculationAutomatic
end sub
Ich bekomme keine signifikante Änderung hinsichtlich der Durchlaufzeit...

AW: Optimierung der Makro-Durchlaufzeit
16.05.2016 15:04:48
Fennek
Hallo,
ich habe deinen Code nicht durchgesehen, aber ich hatte mal 17.000 Zeilen, die in 5-30 Sekunden bearbeitet wurden.
mfg

Anzeige
AW: Optimierung der Makro-Durchlaufzeit
16.05.2016 15:14:17
Bjoern
Ok,
dann habe ich wohl einen dickeren bug im code.
Aber gut zu wissen, dass es schneller gehen kann...:)

Variant statt Long
16.05.2016 18:02:30
KlausF
Hallo Bjoern,
mit
Dim lngLastRow, lngDurchgang, lngStartzeit, lngEndzeit, lngLetzteSpalteRow1, _
lngLetzteSpalteRow2, lngLetzteSpalteRow3, lngLetzteSpalteRow4, lngLetzteSpalteRow5, _
lngLetzteSpalteRow6, lngLetzteSpalteRow7, lngZeile, lngRow As Long
ist nur lngRow als Long definiert, alle anderen als Variant.
Damit belegst Du viel zu viel Speicherplatz im Makro.
Korrekte Schreibweise wäre
Dim lngLastRow As Long, lngDurchgang As Long, lngStartzeit As Long ... usw.
Den Rest habe ich mir jetzt nicht mehr angesehen.
Gruß
Klaus

Anzeige
Der Rest …
16.05.2016 19:10:20
RPP63
…, Klaus, ist aber entscheidender als der Variablentyp.
Ich habe es auch nicht exakt durchgelesen, erst Recht nicht nachgebaut, aber:
Sowas macht man nicht über ein Makro, sondern über bedingte Formatierung, Björn!
Ist zwar volatil, berechnet aber stets nur den sichtbaren Bereich des Window.
Ansonsten:
Beispieldatei!
Gruß Ralf

AW: Variant statt Long
16.05.2016 19:18:43
Piet
Hallo Bjoern,
ich habe mir den Thread angesehen und gehe normalerweise nicht hinein wenn Lösungen vorliegen.
Mich reizt aber deine Aussage von 2,5 Std. bei 17000 Zeilen gegenüber 5-30 Sekunden von Fennek.
Ich kann nicht sagen ob es mir gelingt den Code zu optimieren und brauche Zeit dafür.
Ich bin nicht staendig im Forum, diese Grössenordnung ist nicht in 5 Minuten erledigt.
Wenn ich eine Lösung habe stelle ich den Thread wieder offen unter: "Noch Offen"
Schau einfach zwischendurch mal rein. Mal sehen was ich tun kann ...
mfg Piet

Anzeige
Optimierung
16.05.2016 19:21:26
KlausF
Hallo Bjoern,
habe noch einmal drüber geschaut und u.a. eine For-Next-Schleife verändert.
So ganz steige ich durch das Makro nicht durch. Kannst ja mal testen, ob
das Makro immer noch das macht was Du willst. Datei ist gezippt.
https://www.herber.de/bbs/user/105594.zip
Gruß
Klaus

AW: Optimierung
16.05.2016 22:35:39
Piet
Hallo Bjoern,
ich sehe es gibt bereits eine Lösung von Klaus, anbei deine bearbeitete Beispieldatei.
Wie ich sehe ist Klaus auch der kapitale Fehler in der For Next Schleife aufgefallen!
Ohne Exit For wird bei jedem Durchlauf die Schleife über 1.000.000 mal durchlaufen.
Ich bin gespannt was Klaus zu dem übrigen Makro von mir sagt. Die Idee über fCode.
Ich habe eine Weile gebraucht bis mir das staendige Wiederholen im Code auffiel.
Statt For Next habe ich Suchlauf benutzt. Hoffentlich funktioniert es korrekt.
Ansonsten tut es auch die korrigierte For Next Schleife von Klaus.
mfg Piet
https://www.herber.de/bbs/user/105599.xlsm

Anzeige
AW: Optimierung
19.05.2016 08:36:00
Bjoern
Hallo Piet,
vielen Dank für Deinen Vorschlag und die super Optimierung! Kannst Du mir noch kurz erklären warum mit Deiner Version eine so kurze Durchlaufzeit realisierbar ist? Liegt das nur an dem Befehl Exit for?
Grüße und nochmals vielen Dank für Deine Unterstützung!
Grüße

Optimierung: Vorschlag
17.05.2016 21:11:44
Michael
Hi zusammen,
ich bitte die "Einmischung" zu entschuldigen, aber ich liebe es, Optimierungen vorzunehmen bzw. irgendwelche Sachen auszureizen.
Mit dem Vorschlag https://www.herber.de/bbs/user/105610.xlsm
komme ich bei meiner Maschine auf unter 250 Millisekunden.
Es gibt zwei Varianten:
a) die Werte werden wie vorgesehen in die Auswertung geschrieben.
Dabei fällt auf, daß dort die Vorgabe "Bereich.14" fehlt - dafür steht x-Mal untereinander der 13er da, wobei die überschüssigen 13er nach unten verschoben werden und leer bleiben...
b) aus der Vorlage "Auswertung leer" wird die "Auswertung neu" erzeugt, wobei nur die Bereiche geschrieben werden, die auch in der "Basis" vorhanden sind, und zwar mit der jeweils notwendigen Anzahl von Zeilen.
Von 2,5 h auf 250 ms, das ist, äh, ach, dafür werfe ich jetzt kein Excel an.
Viel Spaß & schöne Grüße,
Michael

Anzeige
AW: Optimierung: Vorschlag
19.05.2016 08:31:36
Bjoern
Hallo Michael,
vielen Dank für Dein Beispiel. Deine Lösung ist für mich absolute Oberklasse und verdammt schnell. Ich bin nicht davon ausgegangen, dass man das Makro dermaßen optimieren kann. Richtig gut gefällt mir das automatische anpassen der Zeilen, bislang musst ich nach den Makro-Läufen die Zeilen manuell anpassen...
Im Anhang findest Du einen Screenshot von dem gewünschten Layout. Hier werden die Werte >= des Vorgängers nacheinander in die nächste, freie Zeile geschrieben. Deine Besispieldatei baut die Tabelle etwas anders auf...
Trotzdem ein sehr beeindruckendes Makro!!!
Piet´s Vorschlag ist für mich am besten nachzuvollziehen und erzielt das gewünschte Ergebnis, ebenfalls in einer sehr guten Zeit. Könnt Ihr mir vielleicht kurz erklären, warum mein Makro so lang läuft. Du hast Exit for erwähnt, kann diesen Befahel aber nicht finden. Was beweirkt dieser?
Grüße und nochmals vielen Dank für die klasse Lösungen!
Userbild

Anzeige
AW: Optimierung: Vorschlag
19.05.2016 14:47:58
Michael
Hallo Bjoern,
ich hatte mir erlaubt, Deine Daten zunächst zu sortieren, weil es mir komisch vorkam, daß sie mit 10 anfangen, bei 50 aufhören und zwischendrin dann 3-5 vorkommt...
Es ist ein Handgriff, die Sortierung anders zu gestalten, damit die Daten in der ursprünglichen Reihenfolge bleiben, aber: ich fürchte, ich habe immer noch nicht ganz begriffen, wann was wohin soll, trotz der Grafik.
Vielleicht hilft's ja, wenn Du sagst, worum es eigentlich geht.
Sei's drum: wenn Dir Piets Lösung taugt (und sie genau das macht, was Du benötigst), soll's ja recht sein.
Schöne Grüße,
Michael

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige