Thema Datum  Von Nutzer Rating
Antwort
Rot Prüfung ob Tag einem einem Datumsbereich liegt
06.07.2023 17:58:12 Daniel
NotSolved
07.07.2023 08:27:44 ralf_b
Solved
07.07.2023 08:39:43 Daniel
NotSolved
07.07.2023 13:32:45 Daniel
Solved

Ansicht des Beitrags:
Von:
Daniel
Datum:
06.07.2023 17:58:12
Views:
518
Rating: Antwort:
  Ja
Thema:
Prüfung ob Tag einem einem Datumsbereich liegt

Hallo zusammen

um meinen Kollegen die Arbeit zu erleichtern bastele ich mit Hilfe von chatGPT an einem Code, komme allerdings an dieser Stelle nicht weiter.

Beschreibung der Aufgabe:

Eine Excel-Datei enthält 2 Blätter: "Buchungsliste" und "Manifest".

Jede Zeile des "Manifest"-Blatts enthält Nachnamen in Spalte A, Vornamen in Spalte B und Geburtsdaten in Spalte I (formatiert als Datum).

Die "Buchungsliste" enthält ebenfalls die gleichen Nachnamen in Spalte B und die gleichen Vornamen in Spalte C, jedoch nicht in jeder Zeile. Wenn ein Name in Spalte B und C vorhanden ist, folgt mindestens eine leere Zeile. Erst in der übernächsten Zeile folgt der Hinweis "Bus-Hinfahrt" oder "Bus-Rückfahrt" in Spalte A und ein korrespondierendes Datum in Spalte B

Hier ist ein typisches Beispiel für die "Buchungsliste":
Zeile 3, Spalte B: "Douglas"; Zeile 3, Spalte C: "Michael"
Zeile 4: leer
Zeile 5: leer
Zeile 6: Spalte A: "Bus-Hinfahrt"; Zeile 6, Spalte B: "01.06.2023"
Zeile 7: Spalte A: "Bus-Rückfahrt"; Zeile 7, Spalte B: "14.06.2023"
Zeile 8, Spalte B: "Douglas"; Zeile 8, Spalte C: "Michael"
Zeile 9: leer
Zeile 10: leer
Zeile 11: Spalte A: "Bus-Hinfahrt"; Zeile 11, Spalte B: "01.06.2023"
Zeile 12: Spalte A: "Bus-Rückfahrt"; Zeile 12, Spalte B: "14.06.2023"

Für jeden Namen und das entsprechende Geburtsdatum im "Manifest"-Blatt sollte der Name in der "Buchungsliste" gefunden werden. Wenn der Name gefunden wurde, sollten die Daten "Bus-Hinfahrt" und "Bus-Rückfahrt" (in den folgenden Zeilen) gefunden werden. Anschließend sollte überprüft werden, ob das Geburtsdatum aus dem "Manifest"-Blatt zwischen den Daten "Bus-Hinfahrt" und "Bus-Rückfahrt" liegt. Wichtig: dabei sollen die Jahreszahlen ignoriert werden. Wenn dies der Fall ist, soll die Zeile hervorgehoben werden.

Der aktuelle Code kopiert mir die Daten nach "Manifest" und stellt den geforderten Vergleich vermeintlich an, allerdings wird keine der Zeilen hervorgehoben, obwohl es mindestens eine geben müsste. Hat jemand eine Idee wo der Fehler steckt?

Liebe Grüße
Daniel

I apologize for the confusion. It seems there is still an issue with the date comparison. Let's try a different approach to compare the dates correctly. Here's the updated code:

vba

Sub UpdateManifestDatesAndHighlight()
    Dim manifestSheet As Worksheet
    Dim buchungslisteSheet As Worksheet
    Dim manifestLastRow As Long
    Dim buchungslisteLastRow As Long
    Dim manifestRow As Long
    Dim buchungslisteRow As Long
    Dim lastName As String
    Dim firstName As String
    
    ' Set the worksheet variables
    Set manifestSheet = ThisWorkbook.Sheets("Manifest")
    Set buchungslisteSheet = ThisWorkbook.Sheets("Buchungsliste")
    
    ' Get the last rows in each sheet
    manifestLastRow = manifestSheet.Cells(Rows.Count, "A").End(xlUp).Row
    buchungslisteLastRow = buchungslisteSheet.Cells(Rows.Count, "B").End(xlUp).Row
    
    ' Clear the existing dates in columns J and K of Manifest
    manifestSheet.Range("J4:K" & manifestLastRow).ClearContents
    manifestSheet.Range("H4:H" & manifestLastRow).ClearContents
    
    ' Loop through each row in the Manifest sheet starting from the fourth row
    For manifestRow = 4 To manifestLastRow
        
        ' Get the last name and first name from the Manifest sheet
        lastName = manifestSheet.Cells(manifestRow, "A").Value
        firstName = manifestSheet.Cells(manifestRow, "B").Value
        
        ' Loop through each row in the Buchungsliste sheet
        For buchungslisteRow = 3 To buchungslisteLastRow
            
            ' Check if the current row in Buchungsliste matches the last name and first name
            If buchungslisteSheet.Cells(buchungslisteRow, "B").Value = lastName And _
               buchungslisteSheet.Cells(buchungslisteRow, "C").Value = firstName Then
                
                ' Search for the next rows containing "Bus-Hinfahrt" and "Bus-Rückfahrt"
                Dim busHinfahrtRow As Long
                Dim busRueckfahrtRow As Long
                
                busHinfahrtRow = buchungslisteRow + 1
                Do While buchungslisteSheet.Cells(busHinfahrtRow, "A").Value <> "Bus-Hinfahrt" And _
                         busHinfahrtRow <= buchungslisteLastRow
                    busHinfahrtRow = busHinfahrtRow + 1
                Loop
                
                busRueckfahrtRow = busHinfahrtRow + 1
                Do While buchungslisteSheet.Cells(busRueckfahrtRow, "A").Value <> "Bus-Rückfahrt" And _
                         busRueckfahrtRow <= buchungslisteLastRow
                    busRueckfahrtRow = busRueckfahrtRow + 1
                Loop
                
                ' Copy the dates to the Manifest sheet
                Dim hinfahrtDate As Date
                Dim rueckfahrtDate As Date
                
                hinfahrtDate = CDate(buchungslisteSheet.Cells(busHinfahrtRow, "B").Value)
                rueckfahrtDate = CDate(buchungslisteSheet.Cells(busRueckfahrtRow, "B").Value)
                
                manifestSheet.Cells(manifestRow, "J").Value = Format(hinfahrtDate, "dd.mm.")
                manifestSheet.Cells(manifestRow, "K").Value = Format(rueckfahrtDate, "dd.mm.")
                
                ' Copy column I to column H in Manifest
                manifestSheet.Cells(manifestRow, "H").Value = Format(manifestSheet.Cells(manifestRow, "I").Value, "dd.mm.")
                
                ' Clear the year portion in column H, J, and K
                manifestSheet.Cells(manifestRow, "H").NumberFormat = "dd.mm."
                manifestSheet.Cells(manifestRow, "J").NumberFormat = "dd.mm."
                manifestSheet.Cells(manifestRow, "K").NumberFormat = "dd.mm."
                
                ' Check if the date in column H is between the dates in columns J and K
                Dim dateH As Date
                Dim dateJ As Date
                Dim dateK As Date
                
                dateH = CDate(manifestSheet.Cells(manifestRow, "H").Value)
                dateJ = CDate(manifestSheet.Cells(manifestRow, "J").Value)
                dateK = CDate(manifestSheet.Cells(manifestRow, "K").Value)
                
                ' Compare the dates
                If dateH >= dateJ And dateH <= dateK Then
                    ' Highlight the row
                    manifestSheet.Rows(manifestRow).Interior.Color = RGB(255, 255, 0) ' Yellow
                End If
                
                ' Exit the loop once found
                Exit For
            End If
        Next buchungslisteRow
    Next manifestRow
    
    MsgBox "Dates updated and rows highlighted successfully!"
End Sub

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Prüfung ob Tag einem einem Datumsbereich liegt
06.07.2023 17:58:12 Daniel
NotSolved
07.07.2023 08:27:44 ralf_b
Solved
07.07.2023 08:39:43 Daniel
NotSolved
07.07.2023 13:32:45 Daniel
Solved