Werte aus Tabelle untereinander schreiben

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Namenweise() Dim i&, j&, k&, arr(), arrAusgabe(), arrKopf: arrKopf = Tabelle1.ListObjects(1).HeaderRowRange.Value k = 2 With Tabelle1.ListObjects(1) ReDim arrAusgabe(1 To UBound(arrKopf, 2) - 2, 1 To 4) For i = 1 To .ListRows.Count arr = .DataBodyRange.Rows(i).Value For j = 1 To UBound(arrKopf, 2) - 2 k = k + 1 arrAusgabe(j, 1) = arr(1, 1) arrAusgabe(j, 2) = arr(1, 2) arrAusgabe(j, 3) = arrKopf(1, k) arrAusgabe(j, 4) = arr(1, k) Next j Tabelle2.ListObjects(1).ListRows.Add.Range.Resize(UBound(arrAusgabe)) = arrAusgabe k = 2 Next i End With End Sub

falls es nicht hilft, lade eine Beispieldatei mit passend zugeordneten Daten hoch.



Sub Namenweise()

    Dim i&, j&, k&, arr(), arrAusgabe(), arrKopf: arrKopf = Tabelle1.ListObjects(1).HeaderRowRange.Value    ' Laden der Spaltennamen in arrKopf

    k = 2   ' Startwert der Zählvariable für die  Schleifendurchläufe von Datum und Obstsorte

    If Not Tabelle2.ListObjects(1).DataBodyRange Is Nothing Then Tabelle2.ListObjects(1).DataBodyRange.Delete ' löscht alle alten Einträge der Zieltabelle

    With Tabelle1.ListObjects(1)

        ReDim arrAusgabe(1 To UBound(arrKopf, 2) - 2, 1 To 4)   ' Dimensionierung des arrAusgabe

        For i = 1 To .ListRows.Count                            ' Schleife (i) zum durchlaufen Zeile für Zeile der Ausgangstabelle

            arr = .DataBodyRange.Rows(i).Value                  ' füllen der arr mit Zeile(i) Werten

            For j = 1 To UBound(arrKopf, 2) - 2                 ' Schleife (j) zum Durchlaufen der Spalten

                k = k + 1                                       ' Zählvariable für Spalte

                arrAusgabe(j, 1) = arr(1, 1)                    ' Übergabe in jeden Spaltendurchlauf Vorname

                arrAusgabe(j, 2) = arr(1, 2)                    ' Übergabe in jeden Spaltendurchlauf Nachname

                arrAusgabe(j, 3) = arrKopf(1, k)                ' Übergabe aktueller Spaltendurchlauf (k) Obst

                arrAusgabe(j, 4) = arr(1, k)                    ' Übergabe aktueller Spaltendurchlauf (k) Datum

            Next j

            ' Schreiben des arrAusgabe via Erzeugung von Tabellenzeilen in die neu erzeugten Zellen

            Tabelle2.ListObjects(1).ListRows.Add.Range.Resize(UBound(arrAusgabe)) = arrAusgabe

            k = 2   ' Sppaltenzähler auf 2 setzen

        Next i  ' Sprung in die Nachste Zeile

    End With

End Sub

Gruß Uwe

Hallo

es böte sich auch eine Lösung mit Power-Query, ohne VBA an, ist auch mit wenig/keiner Ahnung von PQ ganz einfach.

Cursor irgendwo in deine Tabelle stellen.
unter 'Daten' - 'aus Tabelle/Bereich' anklicken.
es öffnet sich der PQ-Editor mit den Daten der Tabelle.
Hier alle Obstspalten markieren (Überschriften anklicken) mit Strg oder Shift
Dann unter 'Transformieren' - 'Spalten entpivotieren' wählen.
Jetzt sollte die Ansicht so aussehen, wie gewünscht.
Bei Bedarf die Spaltenüberschriften umbenennen.
Jetzt nur noch unter 'Start' ganz links 'Schließen und Laden' wählen, fertig
mit rechter Maus und 'Aktualisieren' bist du immer aktuell, auch wenn in deiner
Ausgangstabelle neue Obstsorten dazu kommen.

Gruß Rolf

Beliebteste Forumthreads (12 Monate)

Werte aus Tabelle untereinander schreiben

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Werte aus Tabelle untereinander schreiben

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread