Clever-Excel-Forum

Clever-Excel-Forum > Office-Anwendungen > Excel > X-faches Kopieren von Zeilen/Einträgen
Normale Version: X-faches Kopieren von Zeilen/Einträgen
Du siehst gerade eine vereinfachte Darstellung unserer Inhalte. Normale Ansicht mit richtiger Formatierung.
Seiten: 1 2

SlawaV

28.01.2019, 21:17
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

Kuwer

28.01.2019, 22:13
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

SlawaV

31.01.2019, 11:42
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

Gast 123

31.01.2019, 12:42
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

Ego

31.01.2019, 14:01
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))

Jockel

31.01.2019, 14:18
Hallo, hier mal eine Power Query - Variante ..:

[attachment=22256]

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

Gast 123

31.01.2019, 18:06
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

SlawaV

01.02.2019, 09:01
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

SlawaV

01.02.2019, 09:03
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

Kuwer

01.02.2019, 09:52
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
Seiten: 1 2
Clever-Excel-Forum > Office-Anwendungen > Excel > X-faches Kopieren von Zeilen/Einträgen