Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1644to1648
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Zeitraster erstellen mit vba / Kalendergestaltung

Zeitraster erstellen mit vba / Kalendergestaltung
07.09.2018 22:45:47
Markus
Hallo liebe Forumsmitglieder,
ich habe folgende Problemstellung bei der Erstellung eines Wochenkalenders mit variabler Zeiteinteilung.
Ziel ist aus einer bestimmten Zelle die Startuhrzeit(z.B. [A1] 08:00) und aus [A2] z,B, 00:15 als Raster in einen VBA Code übernehmen.
Anschliessend soll daraus für einen Bereich A5:A40 folgende Spaltenfüllung erzeugt werden:
A5 = 08:00
A6 = 08:15 (bzw. der Rasterwert aus [A2]
A7 = 08:30
usw.
Die Übergabe in VBA deshalb, damit sie in einem Modul für die Erstellung mehrere Wochenpläne Verwendung finden kann. Bisher war die Suche in versch. Nachschlagewerken leider erfolglos.
Wer kann mir bitte helfen & vielen Dank vorab
Grüße
Markus

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zeitraster erstellen mit vba / Kalendergestaltung
07.09.2018 22:59:03
daniel
HI
wie wäre die Funktion: Inhalte ausfüllen - Reihe?
natürlich auch per VBA nutzbar:
With Range("A5:A40")
.Cells(1, 1).Value = Range("A1").Value
.DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=Range("A2")
End With
wenn die Anzahl der Zellen nicht fix vorgegeben ist, sondern bspw die Enduhrzeit in A3, dann geht das auch mit dieser Funktion
With Range("A5")
.Value = Range("A1").Value
.DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=Range("A2"), stop:=Range("A3")
End With
gruß Daniel
Anzeige
AW: Zeitraster erstellen mit vba / Kalendergestaltung
07.09.2018 23:53:18
Markus
Hallo Daniel,
vielen Dank - es funktioniert, allerdings bekomme ich es nicht auf alle Tabellenblätter die erzeugt werden hin, nur das erste Blatt wird entsprechend angelegt.
Im Original wird das Zeitraster wie folgt anglegt und dann in den 53 Wochen suaber eingefügt:
' Zeitspalte einfügen
.Range("A3") = "00:00"
.Range("A3").AutoFill Destination:=.Range("A3:A26")
Ich habe versucht deine Code Zeilen einzufügen, aber iwie ist wohl VBA nciht meine Stärke ;-(; habe auch versucht zu beginn die Variablen zu deklarieren, aber auch das funktioniert nicht.
Hast Du noch einen Tip wich ich die Funktion aus deiner Antwort hier einbauen kann?
Danke und Grüße
Markus
Anzeige
AW: Zeitraster erstellen mit vba / Kalendergestaltung
07.09.2018 23:59:21
daniel
HI
sorry, aber ich habe aufgrund deiner Beschreibung keinen Plan, was du vor hast.
und warum füllst du Zellen mit .AutoFill?
absolut unnötig.
.Range("A3:A26") "00:00"
tuts genauso (wobei sich die Frage stellt, warum 0-Werte in die Zellen schreiben)
Gruß Daniel
AW: Zeitraster erstellen mit vba / Kalendergestaltung
08.09.2018 00:47:25
Markus
Hallo Daniel,
ich muss dir recht geben - ist nciht gut beschrieben. Ich versuche gerade meine VBA Kenntnisse darüber zu erweitern indem ich bestehende BEispiele versuche zu ergänzen. Zum besseren Verständnis lade ich die Datei hoch in der Hoffnung, Hilfe zu bekommen, wie ich das starre 1h Raster im Code durch eine variables ersetzen kann (Startzeit, Raster, Stopzeit). Der Rest des Codes tut eigentlich was ich mir erhoffe.
Meine Problemzone liegt bei der Anpassung "'Zeitspalte einfügen"
Sub Wochenkalender()
Dim intYear As Integer            ' Jahr
Dim bytWS As Byte                 ' Blätter für 52 Woche
Dim bytTitle As Byte              ' Wochentage pro Blatt
Dim intDay1 As Integer            ' 1. Tag im Jahr
Dim bytCol As Byte                ' Spaltenindex
Dim bytWeekDay As Byte            ' Wochentage pro Blatt
Application.ScreenUpdating = False
' Das Jahr aus Zelle A29 beziehen
intYear = Range("A29")
' Fehlende Tabellenblätter für 53 Wochen einfügen
For bytWS = Worksheets.Count + 1 To 53
Worksheets.Add After:=Worksheets(Worksheets.Count)
Next bytWS
' Den ersten Tag im Jahr positionieren
For intDay1 = 2 To 8
With Worksheets(1)
' Montag bis Freitag auf 1. Tabellenblatt einfügen
For bytTitle = 1 To 7
.Cells(1, bytTitle + 1) = WeekdayName(bytTitle)
Next bytTitle
' Wochentagsübereinstimmung suchen
If Format(DateSerial(intYear, 1, 1), "dddd") = _
.Cells(1, intDay1) Then
' 1. Datum eintragen
.Cells(2, intDay1) = DateSerial(intYear, 1, 1)
' 1. Woche mit allfälligen Tagen vom alten Jahr befüllen
If intDay1 > 2 Then
.Cells(2, intDay1).AutoFill _
Destination:=.Range(.Cells(2, 2), _
.Cells(2, intDay1))
End If
' 1. Tag im Jahr rot einfärben
.Cells(2, intDay1).Font.Color = vbRed
' Zähler für weitere Spalten aufbereiten
bytCol = intDay1 + 1
End If
End With
Next intDay1
' Startvariable für die weiteren Tage
intDay1 = 2
For bytWS = 1 To 53
With Worksheets(bytWS)
' Tabellenblätter benennen (Kalenderwoche)
.Name = "KW " & bytWS
' Montag bis Freitag pro Tabellenblatt einfügen
For bytTitle = 1 To 7
.Cells(1, bytTitle + 1) = WeekdayName(bytTitle)
Next bytTitle
' Zeitspalte einfügen
.Range("A3") = "00:00"
.Range("A3").AutoFill Destination:=.Range("A3:A26")
' Formatierungen Tage und Zeit
With .Range("B1:H2,A1:A26")
.HorizontalAlignment = xlCenter
.Font.Bold = True
.Interior.ColorIndex = 15
End With
' Formatierungen Zeitrahmen (zweifarbig)
.Range("B3:H10,B20:H26").Interior.ColorIndex = 37
.Range("B11:H19").Interior.ColorIndex = 34
' Rahmenlinien einfügen
With .Range("A3:H26")
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
End With
' Pro Tabellenblatt eine Woche aufbereiten
For bytWeekDay = bytCol To 8
' Datumsangaben an Zellen übergeben
Worksheets(bytWS).Cells(2, bytCol) = _
DateSerial(intYear, 1, intDay1)
' Spaltenzahl pro Tag um 1 erhöhen
bytCol = bytCol + 1
' Tage aufzählen
intDay1 = intDay1 + 1
Next bytWeekDay
' Spaltenindex für die nächste Woche aufbereiten
bytCol = 2
End With
Next bytWS
' Zur ersten Zelle des ersten Tabellenblattes springen
Application.Goto Worksheets(1).Range("A1")
Application.ScreenUpdating = True
End Sub

Vielen Dank nochmal für die Nachhilfe
Grüße
Markus
PS: Der Versuch scheitert die Datei hochzuladen - obwohl ich die gleichen Zugangsdaten verwende werden diese als nciht korrket zurückgewiesen.
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige