VBA Array Probleme beim Befüllen
09.11.2022 10:13:16
Koob,
ich habe ein Problem mit dem Befüllen meines Arrays. In dem Tabellenblatt "Quelle" habe ich folgende Daten:
Spalte 1 Spalte 2 Spalte 3 Spalte 4
Haupt 01.01.2022 01.01.2022
Text1 01.01.2022 01.01.2023 Test1
Text2 01.01.2022 31.03.2023 Test2; Test3
Erwartet wird, dass im Tabellenblatt "Ziel" es so aussieht:
Haupt 01.01.2022 01.01.2022 Haupt
Text1 01.01.2022 01.01.2023 Text1
Text1 01.01.2022 01.01.2023 Test1
Text2 01.01.2022 31.03.2023 Text2
Text2 01.01.2022 31.03.2023 Test2
Text2 01.01.2022 31.03.2023 Test3 -> Der Eintrag fehlt, den benötige ich auch
Hier der Code:
Sheets("Ziel").Cells.Clear
Do While Sheets("Quelle").Cells(Hauptzaehler, 1) ""
If Sheets("Quelle").Cells(Hauptzaehler, 4) = "" Then 'Falls Zelle leer, dann wird das Array mit (0) initialisiert
ReDim arrDaten(0)
arrDaten(0) = Sheets("Quelle").Cells(Hauptzaehler, 1)
Else
arrDaten = Array((Sheets("Quelle").Cells(Hauptzaehler, 1)), Split(Sheets("Quelle").Cells(Hauptzaehler, 4), ";")) 'Array wird mit Daten aus der 4. Spalte der Quelle gefüllt, vorher nach Semikolon gesplittet
End If
If IsEmpty(arrDaten) Then 'Ermittlung wieviele Einträge im Array zum Verarbeiten vorhanden sind
anzDaten = 0
Else
anzDaten = UBound(arrDaten) - LBound(arrDaten) + 1
End If
'Zweite Schleife wird so oft durchlaufen wie Einträge im Array pro Zeile vorhanden sind
For i = 1 To anzDaten
Sheets("Ziel").Cells(Nebenzaehler, 1) = Sheets("Quelle").Cells(Hauptzaehler, 1)
Sheets("Ziel").Cells(Nebenzaehler, 2) = Sheets("Quelle").Cells(Hauptzaehler, 2)
Sheets("Ziel").Cells(Nebenzaehler, 3) = Sheets("Quelle").Cells(Hauptzaehler, 3)
Sheets("Ziel").Cells(Nebenzaehler, 4) = arrDaten(arrZaehler)
Nebenzaehler = Nebenzaehler + 1 'Nebenzähler wird für die zweite Schleife genutzt und hochgezählt
arrZaehler = arrZaehler + 1 'Array wird hochgezählt um nächsten Eintrag zu verarbeiten im nächsten Schleifendurchlauf
aktZeileZiel = Nebenzaehler 'Merken der letzten Zeile, die im Ziel gefüllt wurde
Next i
Hauptzaehler = Hauptzaehler + 1
Nebenzaehler = aktZeileZiel
arrZaehler = 0
Loop
Bitte um Hilfe und danke :)