Excel VBA - Datumreihe erstellen

Question

Hallo Gemeinde,

ich möchte aus einem Anfangsdatum und einem Enddatum eine Datumsreihe mittels VBA erstellen.

Als Daten stehen in Spalte A Mitarbeiternamen zur Verfügung.
In Spalte B ein Anfangsdatum und in Spalte C sind die Enddatums enthalten

Mitarbeiter A    2.1.2023     9.1.2023
Mitarbeiter B    7.2.2023     20.2.2023

usw.

Das Makro sollte mir in Spalte F eine Liste erstellen wie folgt:

2.1.2023 Mitarbeiter A
3.1.2023 Mitarbeiter A
...
9.1.2023 Mitarbeiter A
7.2.2023 Mitarbeiter B
...
20.2.2023 Mitarbeiter B

Das Makro soll die Daten solange durchlaufen bis in Spalte A nix mehr steht.

Ich bitte um Hilfe für dieses Vorhaben!
Gruß und Dank im Voraus

Örv

Answer 1

Hallo Örv,

das folgende Makro gehört in ein allgemeines Modul deiner Excel-Arbeitsmappe:

Sub Datumsreihen()
Dim lngLetzte As Long
Dim dDatum As Date
Dim arrListe As Variant
Dim i As Long
Dim lngZeile As Long

'letzte Beschriebene Zeile in Spalte A feststellen
lngLetzte = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

'Array (Feld) für die Mitarbeiter sowie das Anfangs- und Enddatum dimensioren
ReDim arrListe(i, 3)

'Daten der Mitarbeiter ab Zeile 2 in Array einlesen
arrListe = Range("A2:C" & lngLetzte)

'1. Einfügezeile in Spalte F festlegen
lngZeile = 1

'Array durchlaufen
For i = LBound(arrListe, 1) To UBound(arrListe, 1)
  dDatum = arrListe(i, 2)
  'Schleife bis zum Enddatum
  Do
    Cells(lngZeile, 6) = dDatum & " " & arrListe(i, 1)
    'Datum erhöhen
    dDatum = dDatum + 1
    'Zähler für Einfügezeile erhöhen
    lngZeile = lngZeile + 1
    'Schleife nur ausführen, solange das Enddatum nicht überschritten wird
   Loop Until dDatum > arrListe(i, 3)
Next i

End Sub

Achtung:

Die Daten werden in Spalte F ab der Zeile eingefügt. Vorhandene Zellinhalte in Spalte F werden überschrieben.

Gruß

M.O.

Answer 2

oha, wow!

das ist schon fast das wie ich es wollte.

Besteht noch die Möglichkeit, das Datum in Spalte F zu schreiben und den Mitarbeiter daneben in Spalte G?

Wahnsinn, ich danke dir für deine Mühe!

Gruß
ÖRv

Answer 3

Hallo Örv,

auch kein Problem:

Sub Datumsreihen()
Dim lngLetzte As Long
Dim dDatum As Date
Dim arrListe As Variant
Dim i As Long
Dim lngZeile As Long

'letzte Beschriebene Zeile in Spalte A feststellen
lngLetzte = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

'Array (Feld) für die Mitarbeiter sowie das Anfangs- und Enddatum dimensioren
ReDim arrListe(i, 3)

'Daten der Mitarbeiter ab Zeile 2 in Array einlesen
arrListe = Range("A2:C" & lngLetzte)

'1. Einfügezeile in Spalte F festlegen
lngZeile = 1

'Array durchlaufen
For i = LBound(arrListe, 1) To UBound(arrListe, 1)
  dDatum = arrListe(i, 2)
  'Schleife bis zum Enddatum
  Do
    Cells(lngZeile, 6) = dDatum              'Datum
    Cells(lngZeile, 7) = arrListe(i, 1)      'Mitarbeiter
    'Datum erhöhen
    dDatum = dDatum + 1
    'Zähler für Einfügezeile erhöhen
    lngZeile = lngZeile + 1
    'Schleife nur ausführen, solange das Enddatum nicht überschritten wird
   Loop Until dDatum > arrListe(i, 3)
Next i

End Sub

Gruß

M.O.

Answer 4

Grüß dich M.O.,
Danke für deine Hilfe, das funktioniert natürlich super!
Ich bin mir sicher, wir hören uns hier noch des öfteren :-)

Danke und Gruß aus Österreich,

Örv