Monatsplanung für Termine

Question

Hallo
ich habe eine Ausgangstabelle mit folgenden Daten:

Name Rhythmus Wochentag Beginn Ende
A wöchentlich Montag 10:00 11:30
B alle 2 Wochen Dienstag 09:00 10:00
C wöchentlich Montag 14:00 15:30
D 1. Mittwoch Mittwoch 10:00 11:00
E alle 2 Wochen Donnerstag 11:00 12:00
F alle 2 Wochen Freitag 09:00 10:00
G alle 2 Wochen Dienstag 10:00 11:00
H alle 2 Wochen Montag 14:00 15:00

Ich brauche jetzt eine Aufstellung, die mir je Tag die entsprechenden Termine auflistet, wie:
3.11. A 10:00 11:30
3.11. C 14:00 15:30
3.11. H 14:00 15:00
4.11. B 9:99 10:00
usw.

Weiß jemand wie man das mit einem Code angehen kann?
Danke und Gruß Andreas

Answer 1

hi Andreas :-)

probier mal

Makroaufnahme>Sortierung nach Datum > sprtierung nach zeit > Makroaufnahme optimieren

gruss nighty

Answer 2

Hallo nighty,

danke erst einmal für deine Antwort. Nur liegt das Problem etwas anders als du es sicher verstanden hast. Ich habe nur die Daten aus der oberen Tabelle mit Namen und Terminen nach Wochentagen und Zeiten.
Die untere Tabelle mit den konkreten Monatsdaten muss ich monatlich erst neu erstellen, konkret jetzt für den November. Der Code soll z.B. aus "wöchentlich Montag" dann die Daten 3,,10.,17., und 24.11. erzeugen.
Gruß Andreas

Answer 3

Hallo Andreas,

es fehlen noch ein paar Informationen für einen ordentlichen Code.

- Kann sich der Rhythmus ändern?
- Welche Rhytmen gibt es noch (z.B. monatlich, 3. Arbeitstag pro Woche etc.)?
- Wann ist der Beginn für alle X Wochen? (Diese oder nächste Woche)
- In welcher Spalte steht was zu diesem Zeitpunkt anfällt? (Meeting x)

Für einen simplen Code ohne unnötige Stringbearbeitung sollten die Rhytmen zudem eine eigene eindeutige ID (z. B. auf einem separaten Tabellenblatt) erhalten. "A: jede X. Woche", "B: jeden X. Monat" etc. Wobei die Zahl die für das X einzusetzen ist in einer separaten Spalte steht.

Ich denke, wenn du diese Regeln befolgst, sollte sich auch ein ordentlicher Code aufbauen lassen.

Answer 4

Hallo,
danke für die Hinweise.
Der Rhythmus steht für jedem Monat fest und ist durch den/die Wochentag(3) und die Anzahl bestimmt der Tage bestimmt. z.B. Montag , 1 würde den ersten Montag im Monat betreffen, Dienstag 3 die drei ersten Dienstage im Monat usw.
Die Spalten 4 und 5 stehen für den Beginn und das Ende des Meetings.
Der Begin des Rhythmus ist jeder Monatsanfang.
Ich hoffe, das hilft zum besseren Verständnis weiter.
Gruß A.

Answer 5

hi Andreas ^^

ein Ansatz erstmal
fuer die Uhrzeiten hab noch keine Idee

spalte a die Wochentage
eine Inputbox fordert eine monatszahl
spalte b ausgabe

gruss nighty

Sub Termine()
Dim lngCounter As Long, DTermine As Long
Dim Eingabe As Integer, MTage As Integer
Do
Eingabe = InputBox("Eingabe der MonatsZahl bitte !")
Loop Until Eingabe > 0 And Eingabe < 13
ReDim Dat(Day(DateSerial(Year(Date), Eingabe + 1, 0)), 1) As String
For lngCounter = 0 To Day(DateSerial(Year(Date), Eingabe + 1, 0)) - 1
Dat(lngCounter, 0) = Format(DateSerial(Year(Date), Eingabe, lngCounter + 1), "DDD")
Dat(lngCounter, 1) = lngCounter + 1 & "." & Eingabe & "." & Year(Date)
Next lngCounter
For DTermine = 1 To ActiveSheet.Range(Cells(Rows.Count, 1), Cells(Rows.Count, 1)).End(xlUp).Row
For MTage = 0 To Day(DateSerial(Year(Date), Eingabe + 1, 0)) - 1
If Mid(Cells(DTermine, 1), 1, 2) = Dat(MTage, 0) Then
Cells(DTermine, 2) = Dat(MTage, 1)
Dat(MTage, 0) = ""
Exit For
End If
Next MTage
Next DTermine
End Sub

Answer 6

Hallo nighty,

vielen Dank für die Mühe, die du dir gemacht hast!!! Der Code ist in vieler Hinsicht sehr interessant, passt aber noch nicht ganz zu meinem Problem. Ich habe eine Lösung gefunden, die funktioniert, aber sicher nicht sehr "elegant" ist.....:

Spalten A=Name, B= Frequenz (1-4 oder ohne für die Anzahl im Monat, auch als Kombination z.B. "2 4" möglich), C= Wochentag 1-7, D und E Tages-Anfangs- und Endzeit.

Sub TerminplanR()

Dim Tag As String, x As String
k = 13
m = 0
For m = 0 To 6
Cells(k, 2) = Cells(13, 2) + m
For i = 2 To 10
Tag = Cells(13, 2) + m
x = Weekday(Tag)
If InStr(Cells(i, 3), x) > 0 And InStr(Cells(i, 2), "1") > 0 Or (InStr(Cells(i, 3), x) > 0 And Cells(i, 2) = "") Then
Cells(k, 1) = Cells(i, 1)
Cells(k, 3) = Cells(i, 4)
Cells(k, 4) = Cells(i, 5)
Cells(k, 5) = x
k = k + 1
End If
Next
Next

For m = 7 To 13
Cells(k, 2) = Cells(13, 2) + m
For i = 2 To 10
Tag = Cells(13, 2) + m
x = Weekday(Tag)
If InStr(Cells(i, 3), x) > 0 And InStr(Cells(i, 2), "2") > 0 Or (InStr(Cells(i, 3), x) > 0 And Cells(i, 2) = "") Then
Cells(k, 1) = Cells(i, 1)
Cells(k, 3) = Cells(i, 4)
Cells(k, 4) = Cells(i, 5)
Cells(k, 5) = x
k = k + 1
End If
Next
Next

For m = 14 To 20
Cells(k, 2) = Cells(13, 2) + m
For i = 2 To 10
Tag = Cells(13, 2) + m
x = Weekday(Tag)
If InStr(Cells(i, 3), x) > 0 And InStr(Cells(i, 2), "3") > 0 Or (InStr(Cells(i, 3), x) > 0 And Cells(i, 2) = "") Then
Cells(k, 1) = Cells(i, 1)
Cells(k, 3) = Cells(i, 4)
Cells(k, 4) = Cells(i, 5)
Cells(k, 5) = x
k = k + 1
End If
Next
Next

For m = 21 To 30
Cells(k, 2) = Cells(13, 2) + m
For i = 2 To 10
Tag = Cells(13, 2) + m
x = Weekday(Tag)
If InStr(Cells(i, 3), x) > 0 And InStr(Cells(i, 2), "4") > 0 Or (InStr(Cells(i, 3), x) > 0 And Cells(i, 2) = "") Then
Cells(k, 1) = Cells(i, 1)
Cells(k, 3) = Cells(i, 4)
Cells(k, 4) = Cells(i, 5)
Cells(k, 5) = x
k = k + 1
End If
Next
Next

End Sub

Im Ergebnis wird eine Liste der entsprechenden Termine nach Tagen/Namen und Zeiten erstellt. Vlt. gibt es hier noch Verbesserungsmöglichkeiten...??
Gruß Andreas

Answer 7

Hallo Andreas,

Ich habe eine Lösung gefunden, die funktioniert, aber sicher nicht sehr "elegant" ist.....:

Es muss nicht immer elegant sein, solange es funktioniert. Allerdings halte ich deinen Code nicht für flexibel genug, um mal schnell Rhytmusanpassungen vorzunehmen. Leider beziehst du dich in deinem Code auf Daten deren Position und Inhalt du in diesem Beitrag noch nicht gepostet hast. Ich habe daher mal eine Alternative auf Basis der Daten in deiner Ausgangsfrage aufgebaut. Die Rhytmen sind momentan auf die genannten Typen begrenzt aber in den Zahlen und Tagen variabel. Probiers aus:

Sub Terminplan()

Monat = Month(Date) 'oder Monat=11
Jahr = Year(Date)

Set Planbereich = Range("A1:E8")
Set Zielbereich = Range("A13") 'die obere linke Zelle des Zielbereichs


Zeilen = Planbereich.Rows.Count
Set Plan = Planbereich.Cells
sz = Zielbereich.Row
sc = Zielbereich.Column

For z = 1 To Zeilen
w = 0
m = 1

'definiert den Rhytmus
If Plan(z, 2) = "wöchentlich" Then
w = 1
ElseIf Plan(z, 2) Like "*alle*Wochen*" Then
s = InStr(1, Plan(z, 2), " ") + 1
e = InStr(1, Plan(z, 2), " Wochen") - 1
w = Val(Mid(Plan(z, 2), s, e - s + 1))
ElseIf Plan(z, 2) Like "#. " & Plan(z, 3) Then
m = Val(Left(Plan(z, 2), 1))
w = 100
End If

'Nummeriert den Wochentag, vorausgesetzt dieser steht in Spalte 2 als String
wd = Switch(Plan(z, 3) = "Montag", 1, Plan(z, 3) = "Dienstag", 2, Plan(z, 3) = "Mittwoch", 3, _
Plan(z, 3) = "Donnerstag", 4, Plan(z, 3) = "Freitag", 5, Plan(z, 3) = "Samstag", 6, Plan(z, 3) = "Sonntag", 7)

'sucht den ersten gültigen Tag
t = 0 'setzt den Tag auf den ersten des Monats zurück
wx = 0 'setzt die Woche auf die erste des Monats zurück
Do
t = t + 1 'zählt den Beginn-Tag weiter, wenn nicht der richtige Beginn gefunden
wx = wx + 1 'zählt die Beginnwoche weiter, wenn noch nicht erreicht.
Do While Weekday(DateSerial(Jahr, Monat, t), vbMonday) <> wd 'Solange kein Beginn gefunden
t = t + 1 'zählt den Tag des Monats um 1 hoch
Loop
Loop Until wx = m 'Schleife bis der richtige Beginn gefunden

'Schreibt die Daten nach Rhytmus
If w > 0 Then 'wenn ein Rhytmus definiert wurde
Do
Cells(sz, sc) = DateSerial(Jahr, Monat, t) 'Datum
Cells(sz, sc).NumberFormat = "dd.mm." 'Datumsformat
Cells(sz, sc + 1) = Plan(z, 1) 'Name
Cells(sz, sc + 2) = Plan(z, 4) 'Start Meeting
Cells(sz, sc + 3) = Plan(z, 5) 'Ende Meeting
sz = sz + 1 'zählt die Zielzeile um 1 weiter
If sz = 4692 Then Stop
t = t + 7 * w 'zählt den Tag des Monats um 1 Rhythmus hoch
Loop Until t > Day(DateSerial(Jahr, Monat + 1, 1) - 1) 'Schleife bis Monatsende

End If

Next z

'Formatiert die Termine als Uhrzeit
Range(Cells(Zielbereich.Row, sc + 2), Cells(sz, sc + 3)).NumberFormat = "hh:MM"

'Sortiert die Werte nach Datum und Uhrzeit
Range(Cells(Zielbereich.Row, sc), Cells(sz, sc + 3)).Sort _
Key1:=Cells(Zielbereich.Row, sc), Order1:=xlAscending, _
Key2:=Cells(Zielbereich.Row, sc + 2), Order2:=xlAscending, _
Key3:=Cells(Zielbereich.Row, sc + 1), Order3:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom


End Sub

Übrigens. Wenn du noch ein For Monat = 1 to 12 drumrum schreibst, kannst du gleich ein ganzes Jahr erstellen.

Gruß Mr. K

Answer 8

Hallo Mr.K.,

danke für deinen Vorschlag, der mir sehr gut gefällt. Ich muss noch versuchen ihn genau an meine Problemstellung anzupassen - hoffe das gelingt mir, sonst melde ich mich noch einmal.
Gruß Andreas

Answer 9

Hallo Mr. K.,

habe deinen Code nach allen Regeln getestet, er funktioniert super und erzeugt das gewünschte Ergebnis. Gegenüber meiner bescheidenen aber funktionierenden Lösung ist das schon die hohe Schule!!!
Vielen Dank und Gruß
Andreas

Answer 10

hi all ^^

ich denke wenn die Wochentage und Uhrzeiten vorher sortiert werden,
sind einige schleifen verbannt und eventuell mit 2 schleifen machbar

gruss nighty