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