Auswertung Datum (max und min aus Bereich)

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Peter
Versuch mal sowas:

' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Public Sub test()
Dim out() As Variant 'Ausgabe Array
Dim Z As Integer 'Ein Zähler
Dim minDatum As Date
Dim maxDatum As Date
Z = 1
Redim Preserve out(1 To 2, 1 To Z)
minDatum = WorksheetFunction.Min(Sheets("Tabelle1").Range("A:A"))
maxDatum = WorksheetFunction.Max(Sheets("Tabelle1").Range("A:A"))
out(1, Z) = Format(DateSerial(Year(minDatum), Month(minDatum), 1), "DD.MM.YY") 'Monatsersten
out(2, Z) = Format(DateSerial(Year(minDatum), Month(minDatum) + 1, 0), "DD.MM.YY") 'Monatsletzten

Do
    Z = Z + 1
    Redim Preserve out(1 To 2, 1 To Z)
    out(1, Z) = Format(DateSerial(Year(minDatum), Month(minDatum) + Z - 1, 1), "DD.MM.YY")
    out(2, Z) = Format(DateSerial(Year(minDatum), Month(minDatum) + Z, 0), "DD.MM.YY")
Loop Until out(1, Z) = Format(DateSerial(Year(maxDatum), Month(maxDatum), 1), "DD.MM.YY") 'Bis der Monatserste von minDatum =der Monatserste von maxDatum

Sheets("Tabelle1").Range("E3").Resize(2, UBound(out, 2)) = out 'Ausgeben
End Sub

Weils draußen so warm und ich so faul bin, ohne irgendeine Fehlerbehandlung ;-)
ransi

Hallo Peter,
1. Was wird mit dem 2. Redim Preserve out (1 to 2, 1 to Z) bewirkt?
Die Größe des Arrays ist zu Beginn der Do-Loop-Schleife noch nicht bekannt. Deshalb muss das Array bei jedem Schleifendurchlauf vergrößert werden. Deshalb diese Anweisung inklusive des Parametrs "Preserve", der dafür sorgt, dass die schon im Array vorhandenen Werte nicht gelöscht werden.
Durch starten des Zählers bei Z=0 kann man auf die 1. ReDim-Anweisung aber auch ganz verzichten.
2. Was muss ich ändern, dass die in den Zellen eingetragenen Daten serielle Zahlen sind, die nur als Datum angezeigt werden?
1. Array-Variable als Long deklarieren
2. Die Werte ohne Formatierung ins Array schreiben
3. Was müsste geändert werden, damit die nicht zwei Zeilen nach hinten abgefüllt werden, sondern zwei Spalten nach unten?
Dazu müssen im Resize-Parameter des auszufüllenden Bereichs Zeilen und Spalten getauscht werden und das Array muss transponiert (Zeile/Spalten vertauscht) werden.
Gruß
Franz

Public Sub test()
Dim out() As Long 'Ausgabe Array
Dim Z As Integer 'Ein Zähler
Dim minDatum As Date
Dim maxDatum As Date
minDatum = WorksheetFunction.Min(Sheets("Tabelle1").Range("A:A"))
maxDatum = WorksheetFunction.Max(Sheets("Tabelle1").Range("A:A"))
Z = 0
Do
Z = Z + 1
ReDim Preserve out(1 To 2, 1 To Z)
out(1, Z) = DateSerial(Year(minDatum), Month(minDatum) + Z - 1, 1) 'Monatsersten
out(2, Z) = DateSerial(Year(minDatum), Month(minDatum) + Z, 0) 'Monatsletzten
'Bis der Monatserste = der Monatserste von maxDatum
Loop Until out(1, Z) = CLng(DateSerial(Year(maxDatum), Month(maxDatum), 1))
'Zeilenweise Ausgabe des Ergebnisses, dazu muss Array Transponiert werden
Sheets("Tabelle1").Range("E3").Resize(UBound(out, 2), 2) _
= Application.WorksheetFunction.Transpose(out) 'Ausgeben
End Sub

Beliebteste Forumthreads (12 Monate)

Auswertung Datum (max und min aus Bereich)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

313 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Auswertung Datum (max und min aus Bereich)

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

313 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread