Komfortable i Schleifenlösung o.ä. gesucht :)

Hallo alle Zusammen,
ich habe folgendes Problem, welches ich selber nur sehr unschön lösen könnte, wenn überhaupt.
Ich beschreibe jetzt mal ausführlich um was es geht, bitte nicht erschlagen fühlen, das Problem selbst ist eigentlich ganz simpel zu beschreiben. Das Excel File habe ich auch beigefügt.
Für ein Projekt plane ich für mehrere Standorte verschiedene Rollen auf Stundenbasis und ein paar zusätzliche Aufwendungen auf Kostenbasis.
Geplant wird immer quartalsweise für 5 Jahre.
Welche Rollen jeder Standort zu Verfügung stellen kann ist fix, jedoch benötigt man für ein Projekt immer nur einen Teil an Rollen sowie nur einen Teil an zusätzlichen Kosten.
Theoretisch können Stunden für eine Projektrolle und zusätzliche Kosten in jedem Quartal innerhalb der 5 Jahre anfallen. Z.B. im Im Quartal 1,2 und 3 vom Jahr 2019 jeweils 200 Stunden.
Verplante Projektrollen und anfallende Kosten sollen für die weitere Verarbeitung in ein separates Tabellenballt zeilenweise kopiert werden. Konkret steht in einer Zeile z. B. die Stundenanzahl für eine Rolle mit einigen zusätzlichen Informationen und in der nächsten Zeile wieder die Stundenzahl für eine Rolle + einige zusätzliche Infos usw.
Jetzt zum konkreten Problem:
Es sollen nur Rollen in das Tabellenblatt kopiert werden wo größer 0 Stunden anfallen bzw. zusätzlich Kosten die größer 0 sind. Grund, die anderen werden offenbar für dieses Projekt nicht benötigt.
Das Makro sollte beim durchforsten des Tabellenblatts Rollen wo Stunden anfallen / Kosten wo Beträge anfallen erkennen und diese dann mit weiteren Zellen in ein separates Tabellenblatt kopieren. Am Ende sollten in diesem separaten Tabellenblatt untereinander alle verplanten Rollen / verplante Kosten quartalsweise und mit zusätzlichen Projektinformationen auftauchen.
Auf Grund von meinen schlechten VBA Kenntnissen würde ich jetzt unendlich viele If Bedingungen aneinander reihen, obwohl es sicherlich eine elegantere Lösung gibt.
https://www.herber.de/bbs/user/114540.xlsm
Ich habe das Excel-File mal mit angefügt, da es das Problem sicherlich viel besser aufzeigt, als ich hier beschreiben kann. Ich habe als Beispiel mal einige wenige Rollen verplant sowie eine Kostenposition und in dem separaten Tabellenblatt in jeder Zeile die Zelle hingeschrieben, die in diesem konkreten Fall hätten kopiert werden sollen. Außerdem habe ich im Makro eine primitive If Bedingung hinterlegt, mit der ich eine einzige Zeile hätte befüllen können. Es wird schnell klar, dass es nicht effizient wäre für alle Rollen und jeweils 20 Quartale (weil 5 Jahre) zig If Abfolgen zu programmieren.
Für eine deutlich bessere Lösung, wäre ich sehr dankbar :)
Ich hoffe ich konnte alles halbwegs gut beschreiben, ansonsten sehr gerne nachfragen.
Achja, es handelt sich hierbei um eine stark abgespeckte Version des Files, es beinhaltet lediglich das Makro "Import for GPS", da der Upload sonst zu groß war.
Viele Grüße und schon mal vorab vielen Dank
Felix

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Import_For_GPS() Dim zeile As Long Dim letzte As Long Dim anzjahre As Long Dim anzeintrag As Long Dim indziel As Long Dim werte() Dim auswertung() Dim daten Dim quelle As Object Dim ziel As Object Dim i As Long Dim j As Long Dim start As Long Dim jahr As Long Application.ScreenUpdating = False Set quelle = Worksheets("DG_Template") Set ziel = Worksheets("Import for GPS") 'Anzahl der Jahre die ausgewertet werden anzjahre = 7 letzte = quelle.Cells(quelle.Rows.Count, 1).End(xlUp).Row anzeintrag = Application.WorksheetFunction.CountIf(quelle.Range("G19:G" & letzte), ">0") ReDim auswertung(1 To (anzeintrag * 4 * anzjahre), 1 To 13) ReDim werte(3, anzjahre * 4) daten = quelle.Range(quelle.Cells(1, 1), quelle.Cells(letzte, 8 + 21 * anzjahre)) 'indexwerte berechnen start = 6 jahr = quelle.Range("C1") For i = 1 To anzjahre * 4 werte(1, i) = start + IIf((i - 1) Mod 4 = 0, 6, 5) Debug.Print werte(1, i) start = werte(1, i) werte(2, i) = IIf(i Mod 4 = 0, 4, i Mod 4) werte(3, i) = jahr + Int((i - 1) / 4) Next i 'jetzt auswerten indziel = 1 For zeile = 19 To letzte 'zeile muss ausgewertet werden If daten(zeile, 7) > 0 And daten(zeile, 3) "" And daten(zeile, 7) "Total" Then For i = 1 To UBound(werte, 2) If daten(zeile, werte(1, i)) > 0 Then auswertung(indziel, 1) = daten(5, 2) auswertung(indziel, 2) = daten(3, 2) auswertung(indziel, 3) = daten(7, 2) auswertung(indziel, 6) = daten(zeile, 3) auswertung(indziel, 8) = werte(3, i) auswertung(indziel, 9) = werte(2, i) auswertung(indziel, 13) = daten(zeile, werte(1, i)) indziel = indziel + 1 End If Next i End If Next zeile 'ergebnisse zurückschreiben ziel.Range("A8:M" & anzeintrag * 4 * anzjahre) = auswertung Set quelle = Nothing Set ziel = Nothing Application.ScreenUpdating = True End Sub

Sub Import_For_GPS() Dim zeile As Long Dim letzte As Long Dim anzjahre As Long Dim anzeintrag As Long Dim indziel As Long Dim werte() Dim auswertung() Dim daten Dim quelle As Object Dim ziel As Object Dim i As Long Dim start As Long Dim jahr As Long Dim spaltevar As Long Application.ScreenUpdating = False Set quelle = Worksheets("DG_Template") Set ziel = Worksheets("Import for GPS") 'Anzahl der Jahre die ausgewertet werden anzjahre = 7 letzte = quelle.Cells(quelle.Rows.Count, 1).End(xlUp).Row anzeintrag = Application.WorksheetFunction.CountIf(quelle.Range("G19:G" & letzte), ">0") ReDim auswertung(1 To (anzeintrag * 4 * anzjahre), 1 To 13) ReDim werte(3, anzjahre * 4) daten = quelle.Range(quelle.Cells(1, 1), quelle.Cells(letzte, 8 + 21 * anzjahre)) 'indexwerte berechnen start = 6 jahr = quelle.Range("C1") For i = 1 To anzjahre * 4 werte(1, i) = start + IIf((i - 1) Mod 4 = 0, 6, 5) start = werte(1, i) werte(2, i) = IIf(i Mod 4 = 0, 4, i Mod 4) werte(3, i) = jahr + Int((i - 1) / 4) Next i 'jetzt auswerten indziel = 1 spaltevar = 13 For zeile = 19 To letzte 'zeile muss ausgewertet werden If InStr(1, daten(zeile, 1), "costs", vbTextCompare) > 0 Then spaltevar = 12 If daten(zeile, 7) > 0 And daten(zeile, 3) "" And daten(zeile, 7) "Total" Then For i = 1 To UBound(werte, 2) If daten(zeile, werte(1, i)) > 0 Then auswertung(indziel, 1) = daten(5, 2) auswertung(indziel, 2) = daten(3, 2) auswertung(indziel, 3) = daten(7, 2) auswertung(indziel, 6) = daten(zeile, 3) auswertung(indziel, 8) = werte(3, i) auswertung(indziel, 9) = werte(2, i) auswertung(indziel, spaltevar) = daten(zeile, werte(1, i)) indziel = indziel + 1 End If Next i End If Next zeile 'ergebnisse zurückschreiben ziel.Range("A8:M" & anzeintrag * 4 * anzjahre) = auswertung Set quelle = Nothing Set ziel = Nothing Application.ScreenUpdating = True End Sub

Moin! Da jeder Zugriff auf das Tabellenblatt Zeit kostet, habe ich versucht dies zu minimieren.
daten = quelle.Range(quelle.Cells(1, 1), quelle.Cells(letzte, 8 + 21 * anzjahre))
Deshalb werden am Anfang die Eintragungen aus DG Template in die Variable - daten - geschrieben. Das ist dann ein 2 Dimensionales Array - also eine Tabelle, die sich aber sozusagen im Speicher befindet. Damit brauche ich nicht mehr auf das Blatt zugreifen. Die Berechnung der Größe erfolgt über die JAhre und die möglichen Eintragungen pro jahr = 4 quartale mit 5 spalten und einer Summe je jahr = 21 *7 und da es erst in Spalte 8 losgeht die nochmal dazu = 8 + 21 *7
ReDim auswertung(1 To (anzeintrag * 4 * anzjahre), 1 To 13)
Um die gefundenen Werte zurückzuschreiben, habe ich mir ebenfalls ein 2 Dimensionales Array angelegt - dies hat den Namen Auswertung. Die Spalten sind dabei klar, geht ja bis M als 13. Die Zeilen sind vorher noch nicht klar. Deshalb habe ich die max. Anzahl der möglichen Eintragungen abgeschätzt. Einen Eintrag kann nur bekommen, wer in Spalte G einen Wert größer 0 hat. Die zähle ich vorher. Jeder dieser Werte kann dann die Anzahl der Jahre multipliziert mit den 4 Quartalen an möglichen Eintragungen haben (das ist: anzeintag * 4 * anzjahre). Da ab und an mal eine Zwischensumme auftaucht, wird die auch mitgezählt. Damit haben wir ein paar mehr Zeilen, ist aber unproblematisch. Sollten nur nicht zu wenig sein. Darein schreiben ich unten in der FOR Schleife alle gefundenen Daten.
Jetzt zum REst.
ReDim werte(3, anzjahre * 4)
'indexwerte berechnen
start = 6
jahr = quelle.Range("C1")
For i = 1 To anzjahre * 4
werte(1, i) = start + IIf((i - 1) Mod 4 = 0, 6, 5)
start = werte(1, i)
werte(2, i) = IIf(i Mod 4 = 0, 4, i Mod 4)
werte(3, i) = jahr + Int((i - 1) / 4)
Next i
Um zu prüfen, ob es einen Eintrag in die GPS Liste gibt, muss ich in den einzelen Zellen jedes Quartales nachschauen. Dies muss das Programm ja wissen. Die best. Zellen sind ja immer in den selben Spalten. Es geht los mit Spalte 12 dann 17, 22, 27, 33, 38 usw.. Jeder Spalte ist ja auch schon fest ein Quartal und eine Jahr zugewiesen. Deshalb berechne ich das alles schon am ANfang und greife dafür nicht extra nochmal auf das Blatt zu - geht m.E. schneller. Dafür habe ich wieder ein Array. Das hat 3 Zeilen und AnzahlJahre * 4 Quartale an Spalten (das sind ja die einzigen möglichen Spalten). IN der Schleife am Ende des COdestückes werden nun die einzelnen Werte berechnet. Zeile 1 ist die Nummer der Spalte in den ich prüfe, ob da was größer 0 steht. Da wird bei den ersten 3 immer 5 Spalten weiter gegangen und beim 4ten um 6 Spalten. So ist der Dateiaufbau. Wenn der Start also bei 6 losgeht, ist die Formel dahinter 6 +6 = 12 - unsere erste Spalte. (bei nächsten Duchlauf gilt 12 +5 = 17 - so entsteht die Reihe wie eingangs des Absatzes beschrieben) Dazu wird dann das Quartal berechnet, Divison durch 4 mit Rest und wenn das 0 ist dann ist das 4 Quartal ansonsen der Rest (kann nur 1 bis 3 werden). Der Wert kommt in die zweite Spalte von WErte. Und zum Schluß wird noch das JAhr zugeordnet. Immer nach 4 Durchgängen kommt ein Jahr dazu. Das in die dritte spalte.
Wenn ich mit dem Wert aus Zeile 1 nun einen Treffer habe, brauche ich nur das Quartal aus Zeile2 und das JAhr aus Zeile 3 nehmen.
So, war jetzt viel Text. Hoffe es war verständlich. Wenn noch Fragen sind oder es unverständlich war, einfach nochmal melden.
VG

Beliebteste Forumthreads (12 Monate)

Komfortable i Schleifenlösung o.ä. gesucht :)

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread