Schleife dauert ewig
05.11.2013 14:44:29
Albert
ich hab da eine Schleife zusammengebastelt, die zwar läuft aber für 25 Zeilen gut und gerne eine Minute braucht.
In einem späteren Dasein würden dann rund 2200 Zeilen durchlaufen werden. Also nicht prickelnd.
Das Makro macht eigentlich nichts schwieriges. In Abhängigkeit vom Zellwert wird aus dem Sheet "Hilfe" ein Schichtzyklus in den "Regelplan" kopiert.
Sub Schleife()
'Regelschichtplan
'Regelschichtplan auswählen und einfügen
Sheets("Regelplan").Select
For Each Zelle In Range(Cells(6, 2), Cells(Range("B200").End(xlUp).Row, 1))
If Zelle.Value = "A" Then
'A-Schichtzyklus
'Sheet auswählen aus Hilfssheet holen
Sheets("Hilfe").Select
'Zyklus der A-Schicht markieren/kopieren
Range("C4:AK4").Select
Selection.Copy
Sheets("Regelplan").Select
'Zelle für Schichtbeginn markieren
Cells(Selection.Row + 1, Selection.Column).Select
ActiveSheet.Paste
End If
Next Zelle
Application.CutCopyMode = False
For Each Zelle In Range(Cells(6, 2), Cells(Range("B200").End(xlUp).Row, 1))
If Zelle.Value = "B" Then
'B-Schichtzyklus
'Sheet auswählen aus Hilfssheet holen
Sheets("Hilfe").Select
'Zyklus der A-Schicht markieren/kopieren
Range("C5:AK5").Select
Selection.Copy
Sheets("Regelplan").Select
'Zelle für Schichtbeginn markieren
Cells(Selection.Row + 1, Selection.Column).Select
ActiveSheet.Paste
End If
Next Zelle
Application.CutCopyMode = False
For Each Zelle In Range(Cells(6, 2), Cells(Range("B200").End(xlUp).Row, 1))
If Zelle.Value = "C" Then
'C-Schichtzyklus
'Sheet auswählen aus Hilfssheet holen
Sheets("Hilfe").Select
'Zyklus der A-Schicht markieren/kopieren
Range("C6:AK6").Select
Selection.Copy
Sheets("Regelplan").Select
'Zelle für Schichtbeginn markieren
Cells(Selection.Row + 1, Selection.Column).Select
ActiveSheet.Paste
End If
Next Zelle
Application.CutCopyMode = False
For Each Zelle In Range(Cells(6, 2), Cells(Range("B200").End(xlUp).Row, 1))
If Zelle.Value = "D" Then
'D-Schichtzyklus
'Sheet auswählen aus Hilfssheet holen
Sheets("Hilfe").Select
'Zyklus der A-Schicht markieren/kopieren
Range("C7:AK7").Select
Selection.Copy
Sheets("Regelplan").Select
'Zelle für Schichtbeginn markieren
Cells(Selection.Row + 1, Selection.Column).Select
ActiveSheet.Paste
End If
Next Zelle
Application.CutCopyMode = False
For Each Zelle In Range(Cells(6, 2), Cells(Range("B200").End(xlUp).Row, 1))
If Zelle.Value = "E" Then
'E-Schichtzyklus
'Sheet auswählen aus Hilfssheet holen
Sheets("Hilfe").Select
'Zyklus der A-Schicht markieren/kopieren
Range("C8:AK8").Select
Selection.Copy
Sheets("Regelplan").Select
'Zelle für Schichtbeginn markieren
Cells(Selection.Row + 1, Selection.Column).Select
ActiveSheet.Paste
End If
Next Zelle
Application.CutCopyMode = False
End Sub
Ich wär euch um Hilfe und Unterstützung echt dankbar.Gruß
A.