VBA- Kalender seitwärts auflisten, nicht nach unten

[Tommiks]

Guten Morgen zusammen,

ich habe im Internet zwei VBA-Codes zum Thema Kalender erstellen gefunden.
Ich habe von der VBA-Programmierung keine Ahnung. Ich habe die Excel Tabelle hinzugefügt.

Ich will das zweite Arbeitsblatt in der Spalte F und in der Zeile 8 anfangen lassen. Der Monat Februar soll dem Monat Januar in der gleichen Zeile 8 folgen usw. 


Ist das machbar ?
Bedanke mich im Voraus für die HIlfe.

[Case]

Hallo,

so?

  Kalender_in_Spalten.xlsm (Größe: 33,32 KB / Downloads: 9)

[Tommiks]

Wowwww   Perfekt!

Kann man vielleicht die Kalenderwoche in Zeile 6 oder in Zeile 7 hinzufügen?
Den Monatsnamen möchte ich weiterhin behalten...

[RPP63]

Da ich auch gebastelt habe (ohne KW):

Sub Jahreskalender()
Dim j, m&, t&
j = Application.InputBox("Jahreszahl", , Year(Date), Type:=1)
If j <> False Then
  Cells.ClearContents
  Range("A1:A12") = _
    WorksheetFunction.Transpose(Application.GetCustomListContents(8))
  For m = 1 To 12
    For t = 1 To 31
      If Month(DateSerial(j, m, t)) > m Then Exit For
      Cells(m, t + 1) = DateSerial(j, m, t)
    Next
  Next
End If
End Sub

So etwas würde ich aber immer mittels Formeln machen.
Daher gehe ich davon aus, dass Du das nur zum Üben brauchst.

Gruß Ralf

[Tommiks]

Hallo Ralf,

du hast recht. Danke Dir...

[RPP63]

Ah ja, habs falsch verstanden.

Um ein komplettes Jahr waagerecht aufzureihen, reicht:
Range(Cells(1, 2), Cells(1, 366)).Formula ="=Date(2021, 1, Column(A1))"

Ob Schaltjahr oder nicht, kann man in der Formel prüfen.

[Tommiks]

Hallo Ralf,

ab welcher Stelle des Codes müsste ich den neuen Code hinzufügen? Und welchen Beriech muss man entfernen?

[RPP63]

Trägt die Formel ab B1 ein und tauscht Formel gegen Wert:

Sub Kal_horizontal()
Dim j, Tage&
j = Application.InputBox("Jahreszahl", , Year(Date), Type:=1)
If j <> False Then
  Tage = DateSerial(j + 1, 1, 1) - DateSerial(j, 1, 1)
  Cells.ClearContents
  With Range(Cells(1, 2), Cells(1, Tage + 1))
    .Formula = "=Date(" & j & ", 1, Column(A1))"
    .Value = .Value
  End With
End If
End Sub

[Tommiks]

Kann jemand vielleicht die Kalnederwoche hinzufügen? Bedanke mich im Voraus für Hilfe.

[Werner.M]

Hallo,

zum Beispiel so:

Code:

Sub Kal_horizontal()
Dim j, Tage&

j = Application.InputBox("Jahreszahl", , Year(Date), Type:=1)

If j <> False Then
    Tage = DateSerial(j + 1, 1, 1) - DateSerial(j, 1, 1)
    Cells.ClearContents
    With Range(Cells(1, 2), Cells(1, Tage + 1))
        .Formula = "=Date(" & j & ", 1, Column(A1))"
        .Value = .Value
    End With
    With Range(Cells(2, 2), Cells(2, Tage + 1))
        .FormulaR1C1 = "=ISOWEEKNUM(R[-1]C)"
        .Value = .Value
        .NumberFormat = """KW ""00"
    End With
End If
End Sub

Gruß Werner