da ich in diversen Foren bez. meines Anwendungsfalls nicht fündig geworden bin, schildere ich hier diesen und würde mich sehr freuen, wenn mir dabei geholfen werden kann:
Folgender Fall anhand eines ausgewählten Beispiels:
Tabelle 1 (Ausgangstabelle): - Liste mit Stadt (Spalte B), Sportart (Spalte C) und Anzahl "n" (Spalte D), siehe Bild 1
Tabelle 2 (Zieltabelle): - "n-faches Untereinanderkopieren" der Daten aus Tabelle 1 -> Stadt (Spalte B), Sportart (Spalte C), siehe Bild 2
Ich möchte gerne mit einer Formel oder einem VBA-Code (falls es mit einer Formel nicht funktioniert) die Einträge aus Tabelle 1 in die Tabelle 2 untereinander "kopieren".
Beispiel:
In Zeile 5, Tabelle 1 ist "Hamburg" mit der Sportart "Handball" und der Anzahl "1" aufgeführt -> Kopieren in Tabelle 2: "Hamburg" in Spalte B, Zeile 5; "Handball" in Spalte C, Zeile 5 -> Anzahl 1 = 1x in Tabelle 2 kopieren
In Zeile 6, Tabelle 1 ist "Hamburg" mit der Sportart "Volleyball" und der Anzahl "2" aufgeführt
-> Kopieren in Tabelle 2: "Hamburg" in Spalte B, Zeile 6 & Zeile 7; "Volleyball" in Spalte C, Zeile 6 & Zeile 7 -> Anzahl 2 = 2x in Tabelle 2 kopieren
Ich hoffe, dass der Anwendungsfall von mir verständlich beschrieben werden konnte. Bilder sind zur Verdeutlichung hinzugefügt. Besten Dank im Voraus. Viele Grüße Slawa
Sub Tabelle1ZuTabelle2() Dim lngS As Long Dim rngZ As Range lngS = 5 With Worksheets("Tabelle1") For Each rngZ In .Range(.Cells(5, 2), .Cells(Rows.Count, 4).End(xlUp)).Rows Worksheets("Tabelle2").Cells(lngS, 2).Resize(rngZ.Cells(3).Value, 2).Value = rngZ.Value lngS = lngS + rngZ.Cells(3).Value Next rngZ End With End Sub
Gruß Uwe
Folgende(r) 1 Nutzer sagt Danke an Kuwer für diesen Beitrag:1 Nutzer sagt Danke an Kuwer für diesen Beitrag 28 • SlawaV
vielen Dank für die schnelle Antwort. Für den einfachen Fall hat dies einwandfrei funktioniert, super!
Habe noch ein paar Rückfragen dazu, weil ich mich mit VBA leider noch nicht auskenne:
Funktioniert dies auch, wenn in der Spalte "Anzahl" zwischendurch auch eine 0 vorkommt?
"For Each rngZ In .Range(.Cells(5, 2), .Cells(Rows.Count, 4).End(xlUp)).Rows" --> bedeutet hier die gelb markierte 4, dass die x-fache Anzahl in Spalte 4 der Tabelle 1 steht?
kann in der Spalte "Anzahl" auch eine Formel hinterlegt sein, womit die Anzahl aus einem anderen Blatt über "Zählenwenns" berechnet wird?
für die Zeile "Worksheets("Tabelle2").Cells(lngS, 2).Resize(rngZ.Cells(3).Value, 2).Value = rngZ.Value" kriege ich einen Laufzeitfehler '1004': Anwendungs- oder objektdefinierter Fehler angezeigt; die erste 2 in der Klammer steht hier doch für die Spalte in die es eingefügt werden soll oder? wofür steht die 3 bei mgZ.Cells(3) und die 2 bei .Value,2 ?
ich hoffe das Uwe mir nicht böse ist, ich habe den Code einmal auskommentiert soweit es mir möglich war. Ich hoffe korrekt. Zum Schutz vor Nullwerten, weil Resize keine Nullwerte verarbeiten kann! Habe ich noch eine IF Then Prüfung mit eingebaut! Bei Cells(3) ist keine Zeile angegeben. Der Wert wird m.W. aus Zelle "C1" geholt. Ob das richtig ist weiss ich nicht??
mfg Gast 123
Code:
Sub Tabelle1ZuTabelle2() Dim lngS As Long Dim rngZ As Range lngS = 5 With Worksheets("Tabelle1") 'durchsucht alle Zellen ab "B5" (Cells(5, 2)) bis zur letzten Zelle in Spalte "D" (durch LastZelle von unten aus ermittelt) '** Cells(z,s) bedeutet die erste Zahl die Zeile (Row), die 2. Zahl die Spalte (Column) als Index '** Cells(2, "B") kann auch so angegeben werden, mit Spaltenangabe als Buchstabe (VBA Grundlagen) For Each rngZ In .Range(.Cells(5, 2), .Cells(Rows.Count, 4).End(xlUp)).Rows 'IF als Schutz vor Nullwerten in der rng2.Value und rngZ.Cells(3) Zelle !! If rngZ.Cells(3).Value > 0 And rngZ.Cells(3).Value = 0 Then 'Resize vergrössert den Bereich, hier auf "xx" Zeilen, 2 Spalten!! '** bei Cells(3) fehlt die Zeilenangabe, Der Wert wird m.W. aus der Zelle "C1" geholt Worksheets("Tabelle2").Cells(lngS, 2).Resize(rngZ.Cells(3).Value, 2).Value = rngZ.Value lngS = lngS + rngZ.Cells(3).Value End If Next rngZ End With End Sub
da du vorrangig nach einer Formellösung gefragt hast, hier einmal eine einfache Lösung mit einer Hilfsspalte E, in der die Startposition des Eintrags ermittelt wird:
Code:
=INDEX(B$5:B$20;VERGLEICH($G5;$E$5:$E$20;1))
helmut
Für mich ist die Möglichkeit in Excel an Zellen und Bereichen Namen zu vergeben die wichtigste Funktionalität. Sie macht Formeln und den VBA-code verständlicher. Für Makros gilt die Regel: "Nur über benannte Bereiche auf den Inhalt der Zellen zugreifen." Und wofür sind Regeln da? Um nachzudenken bevor man sie bricht.
Folgende(r) 1 Nutzer sagt Danke an Ego für diesen Beitrag:1 Nutzer sagt Danke an Ego für diesen Beitrag 28 • SlawaV
mir sind in meiner Antwort zwei Fehler aufgefallen: vor Cells(3) steht noch rngZ.Cells(3) die Zelle geht von dieser Adresse aus nach unten!
Wird das funktionieren? Nein ... If rngZ.Cells(3).Value > 0 And rngZ.Cells(3).Value = 0 Then musste natürlich so heissen: And rngZ.Cells(3).Value > 0 Then
mfg Gast 123
Folgende(r) 1 Nutzer sagt Danke an Gast 123 für diesen Beitrag:1 Nutzer sagt Danke an Gast 123 für diesen Beitrag 28 • SlawaV
so sollte es laufen (Erklärungen etwas verändert):
Sub Tabelle1ZuTabelle2() Dim lngS As Long Dim rngZ As Range lngS = 5
'Cells(Zeilennummer, Spaltennummer) bedeutet die erste Zahl die Zeile (Row), die 2. Zahl die Spalte (Column) als Index
With Worksheets("Tabelle1") 'durchläuft alle Zeilen (.Rows) ab "B5" (Cells(5, 2)) bis zur letzten Zelle in Spalte 4 ="D" von unten aus ermittelt 'rngZ ist eine Zeile im Spaltenbereich B:D For Each rngZ In .Range(.Cells(5, 2), .Cells(Rows.Count, 4).End(xlUp)).Rows 'wenn die 3. Zelle der Zeile (für die Anzahl gewünschter Zeilen) größer 0 (Null) und nicht leer ist If rngZ.Cells(3).Value > 0 And rngZ.Cells(3).Value <> "" Then 'Resize vergrößert den Bereich, hier auf rngZ.Cells(3).Value Zeilen, 2 Spalten!! Worksheets("Tabelle2").Cells(lngS, 2).Resize(rngZ.Cells(3).Value, 2).Value = rngZ.Value lngS = lngS + rngZ.Cells(3).Value End If Next rngZ End With End Sub
![[-]](https://www.clever-excel-forum.de/images/collapse.png)
