Code / Schleifen vereinfachen
28.11.2022 12:13:56
Richi
Hab Code geschrieben welcher einwandfrei funktioniert, nur läuft das gute Programm viel zulange.
Der Grund dafür sind die Schleifen. Mein bescheidenes VBA Wissen hindert mich daran einen Code zu schreiben der effizienter (schneller) läuft.
Was will ich mit dem Code erreichen:
Ich habe Zeilen mit Zellen Start und Enddatum und nachfolgende Spalten mit denen ich einen Zeitstrahl abbilde. Der Zeitstrahl-Header ist aufgeteilt in 3 Zeithorizonte.
1. Arbeitstage, in meinem Code mit "AT" referenziert
2. Kalenderwochen, beginnend immer an einem Montag, in meinem Code mit "W" referenziert
3. Monate, Datum ist der letzte Tag des Monates, in meinem Code mit "M" referenziert
Mit dem Start/Enddatum jeder Zeile zeichne ich Balken. Ich suche mittels der Schleifen die Spaltennummer des jeweiligen Start und End Datum auf dem Zeitstrahl und übergebe diesen Bereich dem Selection.Interior..... Es müsste doch möglich sein, mit weniger Schleifen den Bereich zu definieren.
Ich hoffe jemand kann mir dabei helfen die Bereichsuche über Schleifen effizienter zu definieren.
Liebe Gruess
Richi
------------------------------------------------------------------------
Sub Zeichnen()
Dim wb As Workbook
Dim wsO As Worksheet
Dim wsS As Worksheet
Dim lzO As Integer
Dim lsO As Integer
Dim i As Integer
Dim s As Integer
Dim e As Integer
Dim StartS As Integer
Dim EndS As Integer
Dim StartSH As Integer
Dim StartZ As Integer
Dim SMonat As Date
Dim Emonat As Date
'--------------------------Startblock zur Geschwindigkeitserhöhung bei Schleifen------------------------
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
Set wb = ThisWorkbook
Set wsO = wb.Worksheets("Overview")
Set wsS = wb.Worksheets("Steuertabelle")
StartSH = 39
StartZ = 13
lsO = wsO.Cells(6, wsO.Columns.Count).End(xlToLeft).Column 'letzte Spalte Ziel ermitteln
lzO = wsO.Cells(wsO.Rows.Count, "A").End(xlUp).Row 'letzte Zeile Ziel ermitteln
wsO.Select
wsO.Cells(StartZ + 2, 1).Select
wsO.Range(Cells(StartZ + 2, StartSH), Cells(lzO, lsO)).ClearContents
wsO.Cells(StartZ + 2, 1).Select
'-----Bereich definieren-----
'----Schleife Start- und Enddatum vertikal----
For i = StartZ + 2 To lzO
If wsO.Cells(i, 31) > wsO.Cells(StartZ - 3, lsO) And wsO.Cells(i, 32) > wsO.Cells(StartZ - 3, lsO) Then GoTo NextIteration
If wsO.Cells(i, 31) wsO.Cells(StartZ - 3, lsO) Then
EndS = lsO
End If '----Schleife Start Datum horizontal----
For s = StartSH To lsO
'Start Datum Arbeitstage
If wsO.Cells(StartZ - 7, s) = "AT" Then
If wsO.Cells(i, 31) = wsO.Cells(StartZ - 3, s) Then
StartS = s
End If
'----Schleife End Datum horizontal----
For e = s To lsO
'End Datum Montag-Freitag in Woche
If wsO.Cells(StartZ - 7, e) = "AT" Then
If wsO.Cells(i, 32) = wsO.Cells(StartZ - 3, e) Then
EndS = e
End If
Else 'End Datum Montag-Freitag in Woche
If wsO.Cells(StartZ - 7, e) = "W" Then
If wsO.Cells(i, 32) >= wsO.Cells(StartZ - 3, e) And wsO.Cells(i, 32) = SMonat And wsO.Cells(i, 32) = wsO.Cells(StartZ - 3, s) And wsO.Cells(i, 31) = wsO.Cells(StartZ - 3, e) And wsO.Cells(i, 32) = SMonat And wsO.Cells(i, 32) = SMonat And wsO.Cells(i, 31) = SMonat And wsO.Cells(i, 32)