Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

X-faches Kopieren von Zeilen/Einträgen
#1
Hallo zusammen, 

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


Angehängte Dateien Thumbnail(s)
       
Antworten Top
#2
Hallo Slawa,

per VBA so z.B.:
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:
  • SlawaV
Antworten Top
#3
Hallo Uwe,

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:

  1. Funktioniert dies auch, wenn in der Spalte "Anzahl" zwischendurch auch eine 0 vorkommt?
  2.  "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?
  3. kann in der Spalte "Anzahl" auch eine Formel hinterlegt sein, womit die Anzahl aus einem anderen Blatt über "Zählenwenns" berechnet wird?
  4. 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 ?
Vielen Dank schon einmal im Voraus.

Viele Grüße
Slawa
Antworten Top
#4
Hallo

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
Antworten Top
#5
Hallo Slawa,

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))


Angehängte Dateien
.xlsx   Slawa.xlsx (Größe: 10,68 KB / Downloads: 10)
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:
  • SlawaV
Antworten Top
#6
Hallo, hier mal eine Power Query - Variante ..:


.xlsx   31012019_Power_Query_Zeilen_wiederholen.xlsx (Größe: 19,2 KB / Downloads: 9)

Arbeitsblatt mit dem Namen 'Tabelle1'
BCD
4StadtSportartAnzahl
5HamburgHandball1
6HamburgVolleyball2
7HamburgBasketball2
8BerlinHandball0
9BerlinBasketball3
10MünchenVolleyball2
11MünchenBasketball4
12FrankfurtHandball2
13FrankfurtVolleyball0
Verwendete Systemkomponenten: [Windows (32-bit) NT 6.01] MS Excel 2010
Diese Tabelle wurde mit Tab2Html (v2.6.0) erstellt. ©Gerd alias Bamberg

Arbeitsblatt mit dem Namen 'Tabelle2'
BC
4StadtSportart
5HamburgHandball
6HamburgVolleyball
7HamburgVolleyball
8HamburgBasketball
9HamburgBasketball
10BerlinBasketball
11BerlinBasketball
12BerlinBasketball
13MünchenVolleyball
14MünchenVolleyball
15MünchenBasketball
16MünchenBasketball
17MünchenBasketball
18MünchenBasketball
19FrankfurtHandball
20FrankfurtHandball
Verwendete Systemkomponenten: [Windows (32-bit) NT 6.01] MS Excel 2010
Diese Tabelle wurde mit Tab2Html (v2.6.0) erstellt. ©Gerd alias Bamberg
Gruß Jörg
ich muss mich erst wieder ganz langsam heran robben. Also bitte ich um Nachsicht

"Wer immer tut, was er schon kann, bleibt immer das, was er schon ist." - Henry Ford
[-] Folgende(r) 1 Nutzer sagt Danke an Jockel für diesen Beitrag:
  • SlawaV
Antworten Top
#7
Hallo

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:
  • SlawaV
Antworten Top
#8
Hallo Ego,

vielen Dank für die Formel und den Hinweis mit der Hilfsspalte. Die Hilfsspalten sind oft Gold wert.

Diese Formel müsste doch auch dann funktionieren, wenn die Anzahl "0" hin und wieder auftaucht oder?

Besten Dank.
Gruß, Slawa
Antworten Top
#9
Hallo Jockel,

vielen Dank für den Hinweis das Ganze mit der Power-Query-Variante zu versuchen.
Diese Variante muss ich auch die Tage mal ausprobieren.

Gruß, Slawa
Antworten Top
#10
Hallo Slawa,

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
Gruß Uwe
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste