Tagesübergreifende Einträge in Tabelle splitten

[Daumling]

Hallo zusammen,

ich würde gerne ein Problem lösen, das ich mit einem einfachen Beispiel illustriere (siehe Attachement):

Ich habe eine Tabelle mit mehreren Spalten - die drei relevanten Spalten für dieses Problem sind "Datum", "von" und "bis".
In dieser Tabelle gibt es Einträge, die "tagesübergreifend" sind, bei der "bis" also kleiner ist als "von" (siehe im Attachment in der IST-Tabelle den gelben Eintrag).

Jetzt benötige ich ein Makro, das mir auf Knopfdruck alle solchen Einträge automatisch splittet.
Das heißt, ein solcher Eintrag soll am aufgeführten Tag nur bis 24:00 (00:00) Uhr gehen und ein weiterer Eintrag soll für den Folgetag erzeugt werden, der ab 00:00 Uhr bis zur ursprünglichen Uhrzeit geht und die anderen Spalten vom vorigen Eintrag übernimmt (siehe im Attachment  in  der SOLL-Tabelle die gelben Einträge).

Selbstverständlich soll abweichend vom Beispiel die bestehende Tabelle erweitert und keine neue Tabelle erstellt werden.
Es ist nicht zwingend erforderlich, dass der neu generierte Eintrag direkt unter dem ursprünglichen ist, da ich ein Makro zum Sortieren habe, das ich einfach direkt hinten dran hängen könnte.

Für Hilfe wäre ich sehr dankbar.

Besten Gruß, Daumling

[RPP63]

Hallo!
Wenn die Tabelle nicht gerade riesengroß ist, dürfte dies schnell genug sein:
Anpassen auf die tatsächlichen Bereiche Deiner Tabelle kannst Du?
Ich habe die Sortierung gleich mit implementiert.

Sub RPP()
Dim i As Long, k As Long
Application.ScreenUpdating = False
k = Cells(Rows.Count, 1).End(xlUp).Row + 1
For i = 3 To Cells(Rows.Count, 1).End(xlUp).Row
   If Cells(i, 3) < Cells(i, 2) Then
      Rows(i).Copy Rows(k)
      Cells(i, 3) = 0
      Cells(k, 2) = 0
      Cells(k, 1) = Cells(i, 1) + 1
      k = k + 1
   End If
Next
Range(Cells(3, 1), Cells(k, 5)).Sort Cells(3, 1), xlAscending, Cells(3, 2), , xlAscending
End Sub

Gruß Ralf

[Daumling]

Hallo Ralf,

danke für deine Antwort.
Ich werde sie mir später genauer ansehen und versuchen auf meinen realen Fall zu überführen.
Ich probiere es erstmal alleine (so lerne ich es wohl am ehesten) - und gebe dann nochmal Rückmeldung über Erfolg / Misserfolg  :19: 

Besten Gruß, Daumling

[pefeu]

Hallo Däumling,

wenn du deine Tabelle von hinten aufrollst, musst du evtl. gar nicht neu sortieren.

Code:

Public Sub Hinzufuegen()

Dim lZeile  As Long

  With ThisWorkbook.Worksheets("Tabelle2")
     For lZeile = .Cells(.Rows.Count, 1).End(xlUp).Row To 3 Step -1
        If .Range("C" & lZeile).Value < .Range("B" & lZeile).Value Then
           .Range("A" & lZeile & ":E" & lZeile).Insert
           .Range("A" & lZeile & ":E" & lZeile).Value = _
           .Range("A" & lZeile + 1 & ":E" & lZeile + 1).Value
           .Range("A" & lZeile + 1).Value = CDate(.Range("A" & lZeile).Value) + 1
           .Range("C" & lZeile).Value = "00:00"
           .Range("B" & lZeile + 1).Value = "00:00"
        End If
     Next lZeile
  End With

End Sub

Gruß Peter

[Daumling]

Hallo Ralf,

deine Lösung hat für das Beispiel super geklappt, leider reichen meine Fähigkeiten nicht aus, das ganze auf mein reales Dokument zu überführen :s .

Das Problem ist, dass der zusätzlich erzeugte Eintrag unten an die Tabelle angehängt wird, statt in die nächste "freie" Zeile zu schreiben.


Ich denke das Problem wird klar, wenn man sich das angehängte Dokument ansieht. Dort habe ich die Originaldatei ein wenig anonymisiert und reduziert, so dass das Problem aber noch nachvollziehbar ist.

Ich habe das Dokument einmal mit einem Beispiel vorbefüllt:
Bei Klick auf "Splitten" (Aufrufen deines Makros ohne Sortieren) wird zwar korrekt gesplittet, aber die zusätzliche Zeile wird unter der Tabelle erzeugt (Zeile 60).
Korrekt wäre, wenn in Zeile 27 der Eintrag erzeugt wird.
Die Tabelle darf nicht länger werden, als bis Zeile 59.

Weiterhin ist mir aufgefallen, dass, wenn ich gesplittet habe und ich das Makro nochmal ausführe, fälschlicherweise ein weiterer Eintrag erzeugt wird.
Dies liegt daran, dass die neue "bis-Zeit" mit 00:00 Uhr auch kleiner ist als die Startzeit 20:00 Uhr. Somit werden mit jedem Makroaufruf neue Einträge von 00:00 bis 00:00 Uhr erzeugt.
Lässt sich das verhindern?

Besten Dank im Voraus und Gruß, Daumling

[Daumling]

Hallo Däumling,

wenn du deine Tabelle von hinten aufrollst, musst du evtl. gar nicht neu sortieren.

Code:

Public Sub Hinzufuegen()

Dim lZeile  As Long

  With ThisWorkbook.Worksheets("Tabelle2")
     For lZeile = .Cells(.Rows.Count, 1).End(xlUp).Row To 3 Step -1
        If .Range("C" & lZeile).Value < .Range("B" & lZeile).Value Then
           .Range("A" & lZeile & ":E" & lZeile).Insert
           .Range("A" & lZeile & ":E" & lZeile).Value = _
           .Range("A" & lZeile + 1 & ":E" & lZeile + 1).Value
           .Range("A" & lZeile + 1).Value = CDate(.Range("A" & lZeile).Value) + 1
           .Range("C" & lZeile).Value = "00:00"
           .Range("B" & lZeile + 1).Value = "00:00"
        End If
     Next lZeile
  End With

End Sub

Gruß Peter

Hallo Peter,

danke für den Hinweis.
Das Sortieren stellt aber kein Problem dar, dafür habe ich einfach ein Makro aufgezeichnet (siehe angehängte Datei in meiner Antwort auf Ralf). Das klappt zuverlässig.

Gruß, Daumling

[RPP63]

Du solltest niemals Formeln "auf Vorrat" in eine Tabelle eintragen, da diese Zellen eben nicht leer sind, auch wenn es durch die Übergabe von "" so aussieht.
Nutze entweder eine "intelligente" Tabelle (Strg+t) oder lasse die Formeln gleich mittels VBA eintragen, wenn Du dies ohnehin verwendest.
#1 ist imo sinnvoller.

Gruß Ralf