Problem mit Do Schleife
15.09.2023 23:25:50
Florianexcelnewby
Ich heiße Flo und bin neu hier im Forum. Seit ein paar Tagen hänge ich nun an meinem Makro und komme nicht weiter. Bin kompletter Neuling was Vba angeht....
Die Anwendung soll eine bestimmte häufig vorkommende Rechnungseingabe deutlich vereinfachen.
(Case 3 und 4 muss ich noch erstellen, das kann igoniert werden)
An sich funktioniert alles wie es soll, aber die Dateneingabe funktioniert leider nur in der ersten Iteration der Cases.
Normal sollte danach die nächste Position der Rechnung eingegeben werden können, wobei Rechnungsnummer und Rechnungsdatum gleich bleiben und nicht erneut eingegeben werden müssen.
Beim ersten Durchlauf werden die Werte wie gewünscht in die Tabelle übertragen, aber bei jedem folgenden passiert nichts. Alles läuft weiter durch und die Daten werden abgefragt über die Input Boxes aber in der Tabelle landet nichts.
Meine Vermutung ist, dass da Variablen zurückgesetzt werden müssten, aber ich weiß nicht welche und wo.
Über Hilfe wäre ich sehr dankbar.
Ich wünsche euch ein schönes Wochenende!
Sub DatumUndOptionen()
Dim Rechnungsdatum As Date
Dim Rechnungsnummer As Variant
Dim Optionen As String
Dim isValidOption As Boolean
Dim Fahrzeugnummer As Variant
Rechnungsdatum = InputBox("Geben Sie das Rechnungsdatum ein (TT.MM.JJJJ):", "Datum eingeben")
If Rechnungsdatum = 0 Then
Exit Sub
End If
Rechnungsnummer = InputBox("Geben Sie die Rechnungsnummer ein:", "Nummer bestätigen")
If Rechnungsnummer = 0 Then
Exit Sub
End If
MsgBox "Überprüfen Sie Ihre Eingabe:" & vbCrLf & "Rechnungsdatum: " & Rechnungsdatum & vbCrLf & "Rechnungsnummer: " & Rechnungsnummer
Do
Do
Dim Einsatzdatum As Date
I = "1"
Einsatzdatum = InputBox("Geben Sie das Einsatzdatum ein (TT.MM.JJJJ):", "Datum eingeben")
Fahrzeugnummer = InputBox("Geben Sie die Fahrzeugnummer ein:", "Fahrzeugnummer bestätigen")
Optionen = InputBox("Zeitraum auswählen:" & vbCrLf & _
"1 - 05:00Uhr - 23:00Uhr" & vbCrLf & _
"2 - 05:00Uhr - 14:00Uhr" & vbCrLf & _
"3 - 14:00Uhr - 23:00Uhr" & vbCrLf & _
"4 - 23:00Uhr - 09:00Uhr" & vbCrLf & _
"0 - Eingabe beenden", "Optionen auswählen")
Select Case Optionen
Case "0", "1", "2", "3", "4"
isValidOption = True
Case Else
MsgBox "Ungültige Option ausgewählt. Bitte wählen Sie 1, 2, 3, 4 oder 0."
isValidOption = False
End Select
Loop While Not isValidOption
Dim lastRow As Long
Dim ws As Worksheet
Dim foundRow As Long
Set ws = ActiveSheet
Select Case Optionen
Case "0"
Exit Sub
Case "1"
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
foundRow = 0
Dim dateFound As Boolean
For i = 1 To lastRow
If ws.Cells(i, 1).Value = Einsatzdatum Then
If IsEmpty(ws.Cells(i, 3).Value) Then
If Format(ws.Cells(i, 4).Value, "hh:mm") = "05:00" And Format(ws.Cells(i, 5).Value, "hh:mm") = "23:00" Then
ws.Cells(i, 3).Value = Fahrzeugnummer
ws.Cells(i, 12).Value = Rechnungsnummer
ws.Cells(i, 13).Value = Rechnungsdatum
dateFound = True
Exit For
End If
End If
End If
Next i
If Not dateFound Then
MsgBox "Zeitfenster nicht verfügbar"
Else
MsgBox "case1 Rechnungsdatum: " & Rechnungsdatum & vbCrLf & "Rechnungsnummer: " & Rechnungsnummer & vbCrLf & "Zeitraum: 05:00Uhr - 23:00Uhr"
End If
Case "2"
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
foundRow = 0
For i = 1 To lastRow
If ws.Cells(i, 1).Value = Einsatzdatum Then
If IsEmpty(ws.Cells(i, 3).Value) Then
If Format(ws.Cells(i, 4).Value, "hh:mm") = "05:00" And Format(ws.Cells(i, 5).Value, "hh:mm") = "14:00" Then
ws.Cells(i, 3).Value = Fahrzeugnummer
ws.Cells(i, 12).Value = Rechnungsnummer
ws.Cells(i, 13).Value = Rechnungsdatum
dateFound = True
Exit For
End If
End If
End If
Next i
If Not dateFound Then
For i = 1 To lastRow
If ws.Cells(i, 1).Value = Einsatzdatum Then
If IsEmpty(ws.Cells(i, 3).Value) Then
If Format(ws.Cells(i, 4).Value, "hh:mm") = "05:00" And Format(ws.Cells(i, 5).Value, "hh:mm") = "23:00" Then
ws.Cells(i, 1).EntireRow.Copy
ws.Cells(i + 1, 1).EntireRow.Insert Shift:=xlDown
ws.Cells(i, 3).Value = Fahrzeugnummer
ws.Cells(i, 12).Value = Rechnungsnummer
ws.Cells(i, 13).Value = Rechnungsdatum
ws.Cells(i, 5).Value = "14:00"
ws.Cells(i + 1, 4).Value = "14:00"
dateFound = True
Exit For
End If
End If
End If
Next i
End If
Case "3"
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
foundRow = 0
For i = 1 To lastRow
If ws.Cells(i, 1).Value = Einsatzdatum Then
If IsEmpty(ws.Cells(i, 3).Value) Then
ws.Cells(i, 1).EntireRow.Copy
ws.Cells(i + 1, 1).EntireRow.Insert Shift:=xlDown
ws.Cells(i, 3).Value = Fahrzeugnummer
ws.Cells(i, 12).Value = Rechnungsnummer
ws.Cells(i, 13).Value = Rechnungsdatum
ws.Cells(i, 5).Value = "14:00"
ws.Cells(i + 1, 4).Value = "14:00"
Exit For
End If
End If
Next i
MsgBox "Rechnungsdatum: " & Rechnungsdatum & vbCrLf & "Rechnungsnummer: " & Rechnungsnummer & vbCrLf & "Zeitraum: 14:00Uhr - 23:00Uhr"
Case "4"
MsgBox "Rechnungsdatum: " & Rechnungsdatum & vbCrLf & "Rechnungsnummer: " & Rechnungsnummer & vbCrLf & "Zeitraum: 23:00Uhr - 09:00Uhr"
End Select
isValidOption = False
Loop
Rechnungsdatum = 0
Rechnungsnummer = 0
Optionen = ""
Fahrzeugnummer = 0
End Sub