Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1692to1696
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

VBA - Kalender erstellen, Inhalt übernehmen

VBA - Kalender erstellen, Inhalt übernehmen
16.05.2019 13:38:00
Tilman
Hi
nur zur Info, die Frage ist eine Folge dieses Themas: https://www.herber.de/forum/archiv/1692to1696/t1692672.htm#1692672
ist von diesem aber unabhängig zu betrachten (d.h. ich freu mich auch über Hilfe von anderen als neopa)
ich hab für diese Fragestellung meine Orginaldatei sukzessive gelöscht:
https://www.herber.de/bbs/user/129809.xlsm
Es geht um folgendes:
1) ich will mit einem Button einen Kalender erstellen
dieser soll folgendermaßen aussehen: In Zeile 5 soll ab Spalte D in jeder Spalte ein Datum stehen zwischen Startdatum (definiert durch zelle D2) und Enddatum (definiert durch Zelle D3) mit einer Spaltenzahl die vorgegeben ist durch den Abstand zwischen Start- und Endatum
2) mit einem 2ten Button soll dieser Kalender wieder gelöscht werden können
3) mit einem dritten Button soll der Kalender gefüllt werden mit:
a) den Formeln aus D6:D11
b) die bedingte Fomatierung aus D5 soll übernommen werden für den Kalenderbereich
Da ich zwar n VBA Grundkurs besucht habe im Studium (vor 4 Jahren) habe ich ein gewisses eingerostetes Grundverständnis... fange ansonsten aber bei 0 an.
Google hat schon ein bisschen geholfen. Jetzt hoffe ich Hilfe von euch zu bekommen beim Rest.
zu1)
Google hat mir da schon was geliefert, was ich jetzt noch modifizieren muss:
Sub create_calender()
'Definitionen
Const C_ADR_FROM = "D2"     'Zelle Start Datum
Const C_ADR_TO = "D3"       'Zelle End Datum
Const C_ADR_TARGET = "5"    'Zielzeile
'Informationen auslesen
Dim ws As Worksheet:    Set ws = ActiveSheet
Dim fromDate As Date:   fromDate = ws.Range(C_ADR_FROM).Value
Dim toDate As Date:     toDate = ws.Range(C_ADR_TO).Value
'Anzahl Tage bestimmen
Dim cntDays As Long:    cntDays = DateDiff("d", fromDate, toDate) + 1
'Start Datum übernehmen
ws.Range(C_ADR_TARGET & 1).Value = fromDate
'ZielRange definieren
Dim target As Range:    Set target = ws.Range(C_ADR_TARGET & "1", C_ADR_TARGET & cntDays)
'Range mit Datum füllen
target.DataSeries , xlChronological, xlDay
End Sub

die Modifikation ist: dass das Datum nicht in einer Spalte erzeugt werden soll, sondern in einer Zeile, ab E5.
Da komm ich schon an meine Grenzen.
Zu2) da hab ich was gefunden was funktioniert:
Sub Schaltfläche5_Klicken()
Range(Cells(lngLastRow + 5, 5), Cells(lngLastRow + 200, 850)).ClearContents
End Sub
zu3)
da hab ich noch gar keine Idee.
kann mir wer helfen?
Mfg
Tilman

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA - Kalender erstellen, Inhalt übernehmen
16.05.2019 16:58:22
mmat
Zu 1
viel ist nicht zu ändern:
Sub create_calender()
'Definitionen
Const C_ADR_FROM = "D2"     'Zelle Start Datum
Const C_ADR_TO = "D3"       'Zelle End Datum
Const C_Row_TARGET = 5    'Zielzeile
'Informationen auslesen
Dim ws As Worksheet:    Set ws = ActiveSheet
Dim fromDate As Date:   fromDate = ws.Range(C_ADR_FROM).Value
Dim toDate As Date:     toDate = ws.Range(C_ADR_TO).Value
'Anzahl Tage bestimmen
Dim cntDays As Long:    cntDays = DateDiff("d", fromDate, toDate) + 1
'Start Datum übernehmen
ws.Cells(C_Row_TARGET, 4).Value = fromDate
'ZielRange definieren
Dim target As Range:    Set target = ws.Range(Cells(C_Row_TARGET, 4), Cells(C_Row_TARGET, 4  _
+ cntDays - 1))
'Range mit Datum füllen
target.DataSeries , xlChronological, xlDay
End Sub
zu 2:
das funktioniert vielleicht zu gut, 200 Zeilen werden gelöscht.
Probiers mal mit

rows(5).clearcontents

Zu 3:
hab noch nicht so ganz kapiert, was dabei rauskommen soll mit den Formeln ab D6. Die bedingten Formate kann man doch am besten gleich beim Befüllen des Kalenders übertragen ...
Anzeige
AW: VBA - Kalender erstellen, Inhalt übernehmen
17.05.2019 07:52:26
Tilman
Hallo MMat,
danke für den ersten Schritt in der Hilfe.
Hier die aktualisierte Datei:
https://www.herber.de/bbs/user/129832.xlsm
zu1) so hab ich es mir vorgestellt. weitere Erweiterungen überleg ich gerade (zum Bsp. eine Intervallangabe. Aktuell wird ja taggenau der Bereich zwischen start und enddatum ausgegeben.
wenn ich jetzt aber nur den ersten tag der monate ausgeben will, da überleg ich grad wie ich das mache.
in excel wär das: Ursprungszelle+31)
zu2) ich hab deine Änderungen übernommen und habs probiert. leider wird dann nur eine Zeile gelöscht. in der Orginaldatei ist der Kalender aber 200 zeilen stark, und die werden dann nicht gelöscht. daher bleibt ich bei der ersten formel.
zu3) was dabei rauskommen soll steht in dem thread hier: https://www.herber.de/forum/archiv/1692to1696/t1692672.htm#1692672
Kurz zusammengefasst: ich übernehme Daten aus 2 Planungstabellen und visualisiere Sie in dem Kalender. Zur Übernahme der Daten werden die Formeln in Spalte D verwendet. vor der VBA Lösung hier hab ich den Datumsbereich vorgegeben (von E bis AEU 200Zeilen stark). Wenn dieser vorgegebene Bereich komplett mit den Formeln aus D gefüllt ist, visualisiert der Kalender echt toll die Daten aus den Planungstabellen. Die Datei ist aber nicht mehr benutzbar. deswegen auch der Hinweis in Zelle E8. Um diese Unbenutzbarkeit zu verhindern, verkleinere ich den Kalender mit VBA (siehe 1)) Um die Datenvisualisierung im Kalender zu übernehmen müssen die Formeln aus Spalte E übernommen werden im Kalender den mir das VBA Skript erstellt hat, dafür der dritte Button.
Du hattest mir den Hinweis gegeben, dass die bedingte Formatierung aus Spalte E direkt übernommen werden kann bei der Erstellung des Kalenders mit dem VBA Skript aus 1). Kannst du mir zeigen wie?
Vielen DAnk schon mal.
Anzeige
AW: VBA - Kalender erstellen, Inhalt übernehmen
17.05.2019 10:43:15
mmat
Hallo,
anbei ein neues VBA, das zumindest das Kalenderthema lösen sollte. Ich habe es geringfügig abgeändert, es kann nun Tages- und Monatsintervalle, loscht erstmal 200 Zeilen und übertragt das Format. Für Ziffer 3 fehlt mir im Moment die Zeit.
Achja, ein Monatsintervall ist ein wenig komplexer als wie nur 31 Tage vorwärtsrechnen.
Option Explicit
Const C_From_Date = "D2"
Const C_To_Date = "D3"
Const C_TargetRow = 5
Const C_Intervall = "M"
Sub create_calender()
Dim ws As Worksheet
Dim fromDate As Long, toDate As Long, cntDays As Long
Dim target As Range
Dim d As Long, m As Long, y As Long, col As Long, newd As Long
Set ws = ActiveSheet
ws.Select
Rows("5:204").ClearContents
fromDate = ws.Range(C_From_Date).Value
toDate = ws.Range(C_To_Date).Value
cntDays = toDate - fromDate + 1
ws.Cells(C_TargetRow, 4).Value = fromDate
If C_Intervall = "D" Then
Set target = ws.Range(Cells(C_TargetRow, 4), Cells(C_TargetRow, 4 + cntDays - 1))
target.DataSeries , xlChronological, 1
Else
d = 1
m = Month(CDate(fromDate))
y = Year(CDate(fromDate))
col = 5
m = m + 1: If m > 12 Then m = 1: y = y + 1
newd = DateSerial(y, m, d)
While newd  12 Then m = 1: y = y + 1
newd = DateSerial(y, m, d)
Wend
cntDays = col - 4
End If
Set target = ws.Range(Cells(C_TargetRow, 4 + 1), Cells(C_TargetRow, 4 + cntDays - 1))
Cells(C_TargetRow, 4).Copy: target.PasteSpecial xlPasteFormats: Application.CutCopyMode =  _
False
End Sub
vg, MM
Anzeige
AW: VBA - Kalender erstellen, Inhalt übernehmen
17.05.2019 11:34:07
Tilman
vielen dank mmat
ich hab das teil übernommen und an die orginaldatei angepasst, kalender wird gut übernommen.
nur eine Frage: aktuell kann ich das Intervall nur ändern indem ich im VBA-Skript die Konstante C_Intervall umändere von D zu M oder zu Y. Gibt es ne Möglichkeit die Konstante zu ändern, indem in Zelle D4: M oder D oder Y eingetragen wird?
ich habs schon Versucht die Konstante mit "D4" im Script zu benennen. Da passiert aber nix wenn in D4 Y,ModerD eingetragen wird, es wird nur ein Kalender erstellt mit Monatsintervall.
Ich werd erst ab Montag wieder weitermachen mit dem Projekt.
Wenn du Zeit findest mir n Script zu schreiben, welches mit fill_calender() die Zellen E6;E7;E9;E10 und E11 in jede Zelle des erstellten Kalenders kopiert, wäre ich echt dankbar.
wenn nicht schau ich ab Montag wie ich das Löse.
Vielen Dank auf jeden Fall für deine Hilfe bis hierhin.
Schönes Wochende
Tilman
Anzeige
AW: VBA - Kalender erstellen, Inhalt übernehmen
17.05.2019 11:45:37
Tilman
nur um mal zu zeigen wie der Kalender funktioniert ohne VBA Tools und was ungefähr das ergebnis sein soll
hier mal ne gekürzte beispieldatei:
https://www.herber.de/bbs/user/129841.xlsm
AW: VBA - Kalender erstellen, Inhalt übernehmen
17.05.2019 12:29:57
mmat
Hallo,
ganz kurz:
um die Konstante in Zelle D4 der Tabelle einzutragen, muß oben stehen:
Const C_Intervall = "D4"
und unten
If range(C_Intervall) = "D" Then
Im Moment kann das Ding nur "D" und "nicht D" (wobei "nicht D" für "M" steht). Für Jahresintervalle ist ein etwas anderes Vorgehen erforderlich.
vg, MM
Anzeige
AW: VBA - Kalender erstellen, Inhalt übernehmen
20.05.2019 14:54:08
Tilman
Hey mm,
hab deinen code mal n bisl verändert:
 Option Explicit
Const C_From_Date = "D2"
Const C_To_Date = "D3"
'Const C_TargetRow = 5
Const C_Intervall = "D4"
Sub create_calender()
Dim ws As Worksheet
'Dim fromDate As Long, toDate As Long
Dim fromDate As Date, toDate As Date, cntDays As Long, cntMonth As Long
Dim target As Range
Dim C_TargetRow As Long
Dim d As Long, m As Long, y As Long, col As Long, newd As Long
Set ws = ActiveSheet
ws.Select
'Rows("5:204").ClearContents
C_TargetRow = 5
fromDate = ws.Range(C_From_Date).Value
toDate = ws.Range(C_To_Date).Value
'cntDays = toDate - fromDate +1
cntDays = DateDiff("d", fromDate, toDate, vbMonday)
cntMonth = DateDiff("m", fromDate, toDate, vbMonday)
ws.Cells(C_TargetRow, 6).Value = fromDate
If Range(C_Intervall) = "D" Then
Set target = ws.Range(Cells(C_TargetRow, 6), Cells(C_TargetRow, 6 + cntDays - 1))
target.DataSeries , xlChronological, xlDay
Else
'd = 1
'm = Month(CDate(fromDate))
'y = Year(CDate(fromDate))
'col = 5
'm = m + 1: If m > 12 Then m = 1: y = y + 1
'newd = DateSerial(y, m, d)
'While newd  12 Then m = 1: y = y + 1
'newd = DateSerial(y, m, d)
'Wend
'cntDays = col - 4
Set target = ws.Range(Cells(C_TargetRow, 6), Cells(C_TargetRow, 6 + cntMonth))
target.DataSeries , xlChronological, xlMonth
End If
Set target = ws.Range(Cells(C_TargetRow, 6 + 1), Cells(C_TargetRow, 6 + cntDays - 1))
Cells(C_TargetRow, 6).Copy: target.PasteSpecial xlPasteFormats: Application.CutCopyMode =  _
_
False
End Sub
was hältst davon?
Anzeige

304 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige