Zeilenweiser Vergleich zweier Spalten

Hallo zusammen ...

Ich habe ein Workbook, mit einem benannten Worksheet ("MusterAl in PJ-2023"). In diesem Worksheet ist in Spalte "D" das Beginndatum eines Lernabschnittes eingetragen, in Spalte "E" das Endedatum. In Spalte "F" stehen die absolvierten Lerneinheiten.

Problemstellung:
Im Endergebnis sollen später die Lerneinheiten den korrekten Jahren zugeordnet werden (2023, 2024,2025) ... dazu soll die Tabelle "aufgeräumt" werden.

Beim Übergang von Zeile 20 zu Zeile 21 ist eine klare Trennung vorhanden.
Beim Übergang von Zeile 37 zu Zeile 38 hingegen ist ein Bruch: ([09.12.2024] [07.02.2025])

Folgendes möchte ich erreichen:

- unter Zeile 37 soll eine weitere Zeile eingefügt werden.
- in Zeile 37 wird Zelle E37 auf den Wert [31.12.2024] gesetzt.
- in der neuen Zeile 38 wird der Wert in D38 auf den Wert [01.01.2025] und die Zelle E38 auf den Wert [07.02.2025] gesetzt.

Dieser ganze Vorgang wird über einen Button in einem Userform gestartet.

Leider habe ich bis jetzt noch nichts erreicht, ausser, das ich in der Userform die letzte Zeil und Spalte des genutzten Bereiches auslesen (und zur Kontrolle in einer MsgBox auswerfen) ließ:

Private Sub btn_001_Click()

'Hier wird die letzte Zeile ermittelt
'Egal in welcher Spalte sich die letzte Zeile befindet
'Es werden alle Spalten geprüft und die letzte Zeile ausgegeben
varLastRow = Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
varLastColumn = Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Column

MsgBox "Letzte Zeile: " & varLastRow & vbCrLf & "Letzte Spalte: " & varLastColumn

End Sub

Ich stelle mir also vor, das mit einer "For-Schleife" jede Zeile des Bereichs abgefragt wird, ob die letzten 4 Zeichen der Zelle in D und die letzten vier Zeichen der Zelle in E übereinstimmen. Wenn nicht, dann tritt das obige Procedere in Kraft.

In Spalte "L" habe ich mit "Bordmitteln" ...

=WENN(RECHTS(D9)>RECHTS(E9);1;0)

... versucht die Prüfung umzusetzen, was auch geklappt hat. Aber leider habe ich es nicht geschafft, das in VBA umzusetzen und die Konsequenz zu programmieren.

Hier meine kleine Beispieldatei: https://www.herber.de/bbs/user/159552.xlsm

(P.S.: ich habe eben nach dem Hochsenden gemerkt, das ich in meine "Bordmittel-Lösung" nur das letzte Zeichen, nicht aber die letzten 4 geprüft habe. Ich denke aber, es ist für die Bedingung unerheblich)

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Public Sub splitOverlapYear() Dim lngLastRow As Long, lngFirstRow As Long, lngFirstCol As Long, i As Long Dim wsA As Worksheet 'Hier wird die letzte Zeile ermittelt 'Egal in welcher Spalte sich die letzte Zeile befindet 'Es werden alle Spalten geprüft und die letzte Zeile ausgegeben 'varLastRow = Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row 'varLastColumn = Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Column Set wsA = ThisWorkbook.Sheets(1) With wsA lngFirstCol = 1 lngLastRow = .Cells(Rows.Count, lngFirstCol).End(xlUp).Row lngFirstRow = .Cells(lngLastRow, lngFirstCol).End(xlUp).Row + 1 MsgBox "Letzte Zeile: " & lngLastRow & vbCrLf & "Erste Zeile: " & lngFirstRow For i = lngLastRow To lngFirstRow Step -1 If Year(.Cells(i, lngFirstCol + 4)) > Year(.Cells(i, lngFirstCol + 3)) Then .Rows(i + 1).Insert .Rows(i).Copy .Rows(i + 1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False .Cells(i + 1, lngFirstCol) = .Cells(i, lngFirstCol) .Cells(i + 1, lngFirstCol + 4) = .Cells(i, lngFirstCol + 4) .Cells(i, lngFirstCol + 4) = DateSerial(Year(.Cells(i, lngFirstCol + 3)), 12, 31) .Cells(i + 1, lngFirstCol + 3) = DateSerial(Year(.Cells(i + 1, lngFirstCol + 4)), 1, 1) End If Next End With End Sub

@Pappawinni

Guten Morgen ...

Mal etwas "Off-Topic".
Die von mr eingestellte Beispieltabelle ist nur ein Minimalbeispiel für eben diesen einen Fall. Das eigentliche Workbook ist komplexer:

Aus einer, über mehrere Jahre gehenden, Planungstabelle werden anhand eines feststehenden Merkmals (Kürzel des Dozentennamens, s. Tabellenblattbenennung) alle Einsätze des Dozenten herausgefiltert und in ein neu erzeugtes Tabellenblatt kopiert (dabei die Formatierungen angepasst,, usw.) Das Ergebnis ist das vorliegende Tabellenblatt (in dem ich nur die relevanten Daten lies)

Hiermit arbeiten nun zwei Kolleginnen.
Für die eine ist das vorliegende Blatt ausreichend (Anfrage an externe Dozenten zur Terminbestätigung) die andere braucht die nach Jahren getrennte Variante, um die Einsätze pro Jahr statistisch zu erfassen.

Dein Makro funktioniert genau so, wie ich es mir vorgestellt habe*. Recht herzlichen Dank für Deine Mühe ;)

Was ich jetzt noch einpflegen muß, fiel mir gestern noch ein: Die beiden Felder der Spalte "F", in denen die Lerneinheiten stehen, werde ich noch rot einfärben lassen, damit klar ist, das hier händisch die LE nachgearbeitet werden müssen.

Geplant war, diese "Subroutine" jetzt in den oben beschriebenen Ur-Code einzufügen, um "alles in einem Rutsch" ablaufen zu lassen. Das eigentliche Userform hat natürlich mehr Elemente und dient auch unterschiedlichen Bearbeitungsschritten.

(* jetzt werde ich versuchen, den Code nachzuvollziehen, um natürlich auch einen Lernerfolg zu haben :) )

Dim z As Long Dim anz As Long Dim i As Long For z = Cells(Rows.Count, 4).End(xlUp).Row To 9 Step -1 anz = Year(Cells(z, 5)) - Year(Cells(z, 4)) If anz > 0 Then Rows(z + 1).Resize(anz).Insert Rows(z).Copy Rows(z + 1).Resize(anz).PasteSpecial xlPasteAll For i = 1 To anz Cells(z + i - 1, 5).Value = DateSerial(Year(Cells(z - 1, 4)), 12, 31) Cells(z + i, 4).Value = DateSerial(Year(Cells(z + i - 1, 4)) + 1, 1, 1) Next End If Next

Beliebteste Forumthreads (12 Monate)

Zeilenweiser Vergleich zweier Spalten

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zeilenweiser Vergleich zweier Spalten

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

302 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread