Option Explicit 'Flughafen Statistik neu
Dim AC As Range, i As Integer
Dim TagDatum As Date, lz1 As Long
Const Pmax = 9 'max Personenzahl
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Ende 'ohne MsgBox Anzeige
If InStr(Target.Address, ":") Then Exit Sub
If Target.Value = Empty Then Exit Sub
On Error GoTo Fehler
'Flughafen Formelzelle überspringen (Personen Eingabe)
If Target.Column = 9 Then Target.Offset(0, 2).Select: Exit Sub
'Bei Datum Eingabe Wochentag einfügen
If Target.Column = 1 Or Target.Column = 3 Or Target.Column = 4 Then
Application.EnableEvents = False
'Wochentag und Flughafen Code Formel einsetzen
TagDatum = Cells(Target.Row, 1)
Cells(Target.Row, 2) = Format(Day(TagDatum), "DDDD")
Range("J11").Copy 'Flughafen Formel kopieren
Cells(Target.Row, 10).PasteSpecial xlPasteFormulas
Application.CutCopyMode = False
Application.EnableEvents = True
End If
'Bei Personen Eingabe Buchungs Nummer prüfen
If Target.Column > 5 And Cells(Target.Row, 4) = Empty Then
Cells(Target.Row, 4).Select
MsgBox "Die Buchungs Nummer fehlt!" & vbLf & _
"Bitte zuerst die Buchungs Nummer einsetzen!", vbInformation: Exit Sub
End If
'Bei Personen Eingabe Buchungs Nummer prüfen
If Target.Column = 11 And Target > Pmax Then
MsgBox "Die max Personenzahl (" & Pmax & ") ist überschritten!" _
& vbLf & "Eingabe bitte korrigieren!", vbInformation
Target.Value = Empty: Target.Select: Exit Sub
End If
'Spalte P, Rückflug Datum Eingabe kopieren
If Target.Column = 16 Then
lz1 = Cells(Rows.Count, 1).End(xlUp).Row
For Each AC In Range("A11:A" & lz1)
If AC.Value = Target.Value Then
For i = 1 To 6
If AC.Cells(i, 1).Interior.ColorIndex > 1 Then _
MsgBox Target & " - Unzulässig, dieser Tag ist bereits voll belegt!", vbCritical: Exit Sub
'Eingabe in leere Zeile (Buchungsnummer leer)
If AC.Cells(i, 4) = Empty Then
Application.EnableEvents = False
'In Rückflug Datum Spalte A - E ausfüllen
AC.Cells(i, 3) = "'Reserviert" 'für Uhrzeit (Notiz)
AC.Cells(i, 1) = Target.Value 'Datum
AC.Cells(i, 3) = Target.Cells(1, 2) 'Uhrzeit
AC.Cells(i, 4) = Cells(Target.Row, 4) 'Buchungs Nr
AC.Cells(i, 5) = "Rückflug" 'Text einfügen
AC.Cells(i, 11) = Cells(Target.Row, 11) 'Personen
AC.Cells(i, 2) = Format(Day(Target), "DDDD") 'Wo-Tag
'Kunden Name, Text + Hinflug Datum als Platzhalter
AC.Cells(i, 19) = "Reserviert: " & Cells(Target.Row, 1)
'Rückflüge in Fettschrift
AC.Cells(i, 1).Resize(1, 5).Font.Bold = True
Application.EnableEvents = True
'Letzte Buchung Meldung, Tag ist voll!
If AC.Cells(i + 1, 1).Interior.ColorIndex > 1 Then _
MsgBox Target & " - letzte Buchung, dieser Tag ist jetzt voll belegt" _
& vbLf & vbLf & "Bitte noch Uhrzeit und Kunden Namen eingeben", vbInformation
Exit Sub
End If
Next i
End If
Next AC
MsgBox "Datum für Rückflug nicht gefunden!", vbInformation: Exit Sub
End If
'Spalte S, Rückflug Uhrzeit und Kunden Name kopieren
If Target.Column = 17 Or Target.Column = 19 Then
'Prüfung ob Rückflug Datum vorhanden ist
If Target.Column = 19 And Cells(Target.Row, 17) = Empty Then
Target.Offset(0, -2).Select
MsgBox "Die Rückflug Uhrzeit fehlt!", vbInformation
End If
lz1 = Cells(Rows.Count, 1).End(xlUp).Row
For Each AC In Range("A11:A" & lz1)
If AC.Value = Cells(Target.Row, 16) Then
For i = 1 To 6
If AC.Cells(i, 1) = Cells(Target.Row, 16) And _
AC.Cells(i, 4) = Cells(Target.Row, 4) Then
Application.EnableEvents = False
AC.Cells(i, 3) = Cells(Target.Row, 17) 'Uhrzeit
AC.Cells(i, 19) = Cells(Target.Row, 19) 'Kunden Name
AC.Cells(i, 19).Font.Bold = True
Application.EnableEvents = True
Exit Sub
End If
Next i
End If
Next AC
MsgBox "Datum für Rückflug nicht gefunden!", vbInformation: Exit Sub
End If
Exit Sub
Fehler: MsgBox "Unerwarteter Target Fehler"
Ende: Application.EnableEvents = True
End Sub