Kalenderblatt per Button automatisch ergänzen

Question

Hallo an alle,

ich habe hier meine excel Tabelle mal als Beispiel:

Beispiel Datei

Bei einem klick auf den Button Buchung im Blatt Eingaben, werden Daten im Blatt Buchungen eingetragen.

Frage 1: Es sollte auch parallel im Blatt Buchungskalender, die gebuchten Tage evtl rot makiert werden und evtl mit wieviel Personen übernachtet wird. Wenn eine Abreise und Anreise am gleichen Tag erfolgt sollte dies erkennbar sein

Frage 2: Das gleiche, wenn ich auf den Button Anfrage klicke. Dann ein Eintrag in das Blatt Anfragenkalender evtl bei einer Anfrage im Zeitraum makiert mit einer 1 und wenn am gleichen Tag schon eine 1 drinn steht, dann um eine Zahl erhöht.

Ich hoffe meine Fragestellung ist verständlich

Liebe Grüße
wimaxe

Answer 1

Hallo,

wollte mal deine Beispieldatei öffnen, erfolgt aber nur eine leere Excelöffnung, noch nicht einmal ein Datenblatt.

Gruß

Helmut

Answer 2

hier die Datei:

datei

wimaxe

Answer 3

Hallo Axel,

schau mal nach, ob Du mit meinem Vorschlag leben kannst.
Musste die Kalender etwas umstellen, hat aber auch den Vorteil, dass Du mit wenig scrollen 3 Jahre überblicken kannst.


Vorschlag

Gruss
Rainer

Answer 4

Hallo Axel.

lösche bitte im Anfragen-Makro folgende Zeile, hatte ich nur zum Testen eingefügt.

MsgBox Worksheets(3).Range("L" & Worksheets(3).Cells(Rows.Count, 3).End(xlUp).Row).Value

Gruss
Rainer

Answer 5

Hallo Rainer,

funktioniert prima, wäre es möglich, die rote Markierung im Buchungskalender, mit einem Rahmen zu versehen?
so könnte ich erkennen, wenn eine Ab.- und Anreise am selben Tag ist.

Gruß
wimaxe

Answer 6

Hallo Axel,

ersetze das Buchungs-Makro mitt diesem Code.

Sub Buchung()
Dim wksQ As Worksheet, wksZ As Worksheet, lngLast As Long
Dim rngC As Range, rngBer As Range, intI As Integer
Set rngBer = Worksheets(2).Range("C2:C" & _
Worksheets(2).Cells(Rows.Count, 3).End(xlUp).Row + 1)
Set wksQ = Worksheets("Eingaben")
Set wksZ = Worksheets("Buchungen")
lngLast = wksZ.Cells(Rows.Count, 1).End(xlUp).Row + 1
With wksZ
.Range("A" & lngLast).Value = wksQ.Range("B2").Value
.Range("B" & lngLast).Value = wksQ.Range("B3").Value
.Range("C" & lngLast).Value = wksQ.Range("B7").Value
.Range("D" & lngLast).Value = wksQ.Range("B8").Value
.Range("E" & lngLast).Value = wksQ.Range("B17").Value
.Range("F" & lngLast).Value = wksQ.Range("B18").Value
.Range("G" & lngLast).Value = wksQ.Range("B20").Value
.Range("H" & lngLast).Value = wksQ.Range("B21").Value
.Range("I" & lngLast).Value = wksQ.Range("I14").Value
.Range("J" & lngLast).Value = wksQ.Range("I15").Value
.Range("K" & lngLast).Value = wksQ.Range("I17").Value
.Range("L" & lngLast).Value = wksQ.Range("B11").Value
End With
Worksheets(4).Cells.Interior.ColorIndex = xlNone
For Each rngC In rngBer
For intI = 0 To rngC.Offset(0, 9).Value
With Worksheets(4).Range("A3:W99") _
.Find(CDate(rngC + intI), Lookat:=xlWhole).Offset(0, 1)
.Interior.ColorIndex = 3
.Borders(xlEdgeLeft).Weight = xlThin
If intI = 0 Then .Borders(xlEdgeTop).Weight = xlThin
If intI = rngC.Offset(0, 9).Value Then _
.Borders(xlEdgeBottom).Weight = xlThin
End With
Next
Next
MsgBox "Buchung erfolgt", 64
End Sub

Gruss
Rainer

Answer 7

Hallo Rainer,

und wenn jetzt noch bei einer Buchung
zb 01.04 bis 05.04 nur Rahmen oben, unten, links und rechts
also kein Rahmen zwischen drinn, dann kann ich Dir 5 Sterne
verleihen
Gruß
wimaxe

Answer 8

Hallo Axcel,

das ist nur eine Frage des Geschmacks und der Formatierung, mit dem Makro hat das nichts zu tun.
Ob Dir das Format im Anhang gefällt musst Du selbst entscheiden und es ggf. verändern.

Download

Gruss
Rainer