Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Zeilen so oft duplizieren wie in Zelle steht

Zeilen so oft duplizieren wie in Zelle steht
06.11.2012 08:10:36
Marc
Hallo,
ich habe die Aufgabe Zellen so oft zu duplizieren, wie im Feld Menge steht.
Im Beispiel habe ich in Tabelle 1 die Ausgangsdaten, in Tabelle 2 steht es so, wie ich es am Schluss brauche. D.h. vom Eintrag 1 aus Tabelle 1 habe ich 8 Wiederholungen, vom Eintrag 2 aus Tabelle 1 habe ich 6 Wiederholungen. Die Liste in Tabelle 1 kann N Einträge haben.
https://www.herber.de/bbs/user/82500.xlsx
Geht das?
Lieben Gruß
Marc

23
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zeilen so oft duplizieren wie in Zelle steht
06.11.2012 08:50:47
Klaus
Hi Marc,
machst dir ein kleines Script für:
Sub MultipiziereZeileMenge()
Dim lRow As Long
Dim lRow2 As Long
Dim rFor As Range
Dim iAnz As Integer
Dim wksEingabe As Worksheet
Dim wksAusgabe As Worksheet
'In deiner Tabelle heissen die Seiten sicher nicht "Tabelle1" und "2"?
Set wksEingabe = Sheets("Tabelle1")     'Tabellenname hier ÄNDERN!
Set wksAusgabe = Sheets("Tabelle2")     'Tabellenname hier ÄNDERN!
lRow2 = wksAusgabe.Range("A65000").End(xlUp).Row    'letzte Zeile im Ausgabeblatt
With wksEingabe
lRow = .Range("D1").End(xlDown).Row                 'letzte Zeile im Eingabeblatt
For Each rFor In .Range("D2:D" & lRow)              'für jede Zeile im Eingabeblatt
rFor.EntireRow.Copy                             'kopiere sie
For lanz = 1 To rFor.Value                      'und füge die X-Mal
lRow2 = lRow2 + 1                           'in die letzte Zeile des Ausgabeblattes
wksAusgabe.Range("A" & lRow2).PasteSpecial  'ein
Next lanz
Next rFor
End With
End Sub
Ich nehme an, es werden nur Werte kopiert und keine Formeln. Desweitern nehme ich an, dass unter und neben den Tabellen nichts weiter steht und dass eine Beispieldatei im Aufbau genau deiner echten Datei entspricht.
Grüße,
Klaus M.vdT.

Anzeige
AW: Zeilen so oft duplizieren wie in Zelle steht
06.11.2012 09:20:31
Marc
Hallo,
wow, danke für das Super Script!! Konnte das ja sogar mit meinen Tabellenblattnamen verändern. Läuft super, danke dafür!!
Marc

Danke für die Rückmeldung! o.w.T.
06.11.2012 09:25:32
Klaus
.

bitte ändern:
06.11.2012 09:44:54
Klaus
Hallo Marc,
die Zeile
lRow2 = wksAusgabe.Range("A65000").End(xlUp).Row 'letzte Zeile im Ausgabeblatt
änderst du bitte in
lRow2 = wksAusgabe.Cells(Rows.Count, 1).End(xlUp).Row 'letzte Zeile im Ausgabeblatt
sonst tötet NoNet jedes mal wenn du das Script ausführst ein Kätzchen :-)
Nein ernsthaft: Die Änderung macht total Sinn, und wenn du später mal was eigenes baust und fix in der Datei nachschaust "wie ging denn das mit der letzten Zeile nochmal", dann währ mir schon wohler wenn du eine saubere und gute Codezeite vorfindest und nicht kopierst, was ich mir noch nicht abgewöhnt hab.
Grüße,
Klaus M.vdT.

Anzeige
Nöö : SOO aggressiv bin ich nicht
06.11.2012 09:50:43
NoNet
Hey Klaus,
sonst tötet NoNet jedes mal wenn du das Script ausführst ein Kätzchen :-)
Nöö, dann würde ich lieber diesen VBA-Knirsch akzeptieren, denn ich liebe Katzen :-)
Aber der Verbesserungsvorschlag ist (auch für Marc) dennoch angebracht.
Gruß, NoNet

@Klaus : Bei 65000 kommt mir die Galle hoch ;-)
06.11.2012 09:29:19
NoNet
Hey Klaus,
auch wenn es in DIESEM Fall keine Rolle spielt : Bitte verwende niemals Range("A65000").end(xlUp) - da fällt mir ja das Gebiss aus dem Mund ;-)
Erstens hatten ältere Excel-Versionen 65536 Zeilen und nicht 65000 und zweitens bezieht sich der Beitrag auf Excel 2007, ergo hat das Blatt vermutlich (falls Xl2007 Format) 1048576 Zeilen - also schlappe 16x so viele !
Ich plädiere seit Jahren (schon zu Excel 2000 Zeiten !) dafür, Cells(Rows.Count, 1).End(xlUp) zu verwenden (mit all den bekannten Unzulänglichkeiten wie verbundene Zellen oder fixierte Zeilen etc.) - das dürfte doch nicht allzu schwierig sein, oder ?
So, Ende des Kampfes gegen die Windmühlen,
Schönen Tag noch, NoNet

Anzeige
/unterschrieben
06.11.2012 09:40:14
Klaus
Hallo NoNet,
ja, du hast recht! Alter Hund und neue Tricks ... danke für den Rüffel!
ich hab mir leider angewöhnt, Range("A1").end(xldown).row zu benutzen da ich nie leere Tabellen habe. Im o.g. Beispiel springt das natürlich nach A1048576 ... drum hab ich fix auf "xlup" geändert damit der Code läuft.
Mea Culpa für den unsauberen Code, kommt nicht mehr vor ....
Grüße und Dank,
Klaus

und dann gibt es noch ...
06.11.2012 11:22:45
Rudi
Hallo,
die Puristen, die erst mal nachschauen, ob die letzte Zelle leer ist.
lRow=Iif(cells(rows.count, 1)"", rows.count, cells(rows.count, 1).end(xlup).Row)
Gruß
Rudi

Anzeige
Genau DAS ist eine weitere der Unzulänglichkeiten
06.11.2012 11:37:03
NoNet
Hallo Rudi,
da gibt es noch zig andere Fälle (z.B. gefilterte Daten) in denen dieses Konstrukt nicht funktioniert, aber wir gehen ja alle vom "Normalfall" aus - auch davon, dass niemand eine Tabelle bis zur letzten Zeile mit Daten befüllt (bzw. nur die letzte Zeile).
Salut, NoNet

OK, Spezialfall: Wie geht das?
06.11.2012 11:52:00
Klaus
Hallo NoNet und Rudi,
Aus akademischem Interesse: Wie prüfe ich denn die letzte Zeile immer eindeutig?
mein sehr theoretisches Konstrukt: A1:A100 sind mit Text gefüllt. A99:A100.EntireRow ist ausgeblendet (und soll es auch bleiben). Die beiden Zellen A99 und A100 sind natürlich verbunden. Zusätzlich liegt über A1:A99 ein Autofilter, der nur Zeile 98 ausfiltert. Die UsedRange geht bis Zeile 10.000, weil ein Depp in Zelle B10000 was geschrieben hat. (Hab ich irgendwas vergessen?)
Um hier zuverlässig die letzte Zeile zu finden, müsste ich ja ungefähr so vorgehen:
For lZellen = 1 to 1048576 step -1
if Range("A" & lZellen) = "" then
lRow = lZellen
else
exit for
next lZellen
Aber das kann ja nicht richtig sein!
Gibts dafür eine "richtige" elegante Lösung?
Grüße,
Klaus M.vdT.

Anzeige
Zeilen mengenmässig duplizieren : kurze Variante
06.11.2012 09:23:00
NoNet
Hallo Marc,
hier noch eine kurze Variante :
Sub ZeilenProMengeKopieren()
Dim wsQ As Worksheet, wsZ As Worksheet, lngZ As Long, lngZ2 As Long
Set wsQ = Worksheets("Tabelle1")
Set wsZ = Worksheets("Tabelle3")
wsQ.Rows(1).Copy wsZ.[A1]     'Überschriftenzeile kopieren
lngZ2 = 2
For lngZ = 2 To wsQ.Cells(Rows.Count, 1).End(xlUp).Row
wsQ.Rows(lngZ).Copy wsZ.Rows(lngZ2).Resize(wsQ.Cells(lngZ, 4))
lngZ2 = lngZ2 + wsQ.Cells(lngZ, 4)
Next
End Sub
Gruß, NoNet

schöne Variante!
06.11.2012 09:30:05
Klaus
Hallo NoNet,
das zweite FOR-NEXT mit einem .resize zu ersetzen ist natürlich eine sehr schöne Idee! Das muss ich noch verinnerlichen, dass es meistens Wege gibt um sich unperformante Extraschleifen zu sparen.
Grüße,
Klaus M.vdT.

Anzeige
AW: Bitte um Meinung
06.11.2012 09:48:19
hary
Hallo NoNet und Klaus
Habe es so geloest.
Dim i As Long
Dim a As Long
a = 2
With Worksheets("Tabelle1")
For i = 2 To .Cells(.Rows.Count, 4).End(xlUp).Row
Worksheets("Tabelle3").Cells(a, 1).Resize(.Cells(i, 4), 8).Value = .Cells(i, 1). _
Resize(1, 8).Value
a = a + .Cells(i, 4)
Next
End With

Also Value gleich einsetzen. Was ist fuer solche Faelle besser, Copy oder Value direkt?
gruss hary

subjektiv AW: Bitte um Meinung
06.11.2012 09:57:27
Klaus
Hallo Hary,
für kleine Bereiche ist das "Jacke wie Hose", oder?
Ich selbst mag lieber COPY und xlPasteValues. Ich habe subjektiv den Eindruck, dass .value = .value gerade bei großen Bereichen langsamer ist - aber keine Messung um das zu bestätigen.
EDIT:
Sub Messung()
Range("A1:A1048576").FormulaR1C1 = "=RAND()"
t = Timer
Range("A1").EntireColumn.Copy
Range("B1").PasteSpecial xlPasteValues
Debug.Print "CopyPaste: " & Timer - t
t = Timer
Range("C1").EntireColumn.Value = Range("A1").EntireColumn.Value
Debug.Print ".value.value: " & Timer - t
End Sub
Ergibt bei mir:
CopyPaste: 0,3085938
.value.value: 0,9414063
kann man daraus jetzt ableiten, dass CopyPaste generell schneller ist als .value = .value?
Grüße,
Klaus M.vdT.

Anzeige
Ist auch OK
06.11.2012 09:57:40
NoNet
Hallo Harry,
Deine Variante, nur die Werte zu übertragen ist auch OK, evtl. sogar besser.
Einen Unterschied erkennt man, wenn man in der Ausgangstabelle ("Tabelle1") z.B. anstelle fixer Werte eine Formel oder Funktion eingibt (z.B. in Zelle C2 : =ZEILE()).
Mit der .COPY Methode wird die Funktion x-fach kopiert, also steht in der Zieltabelle in jeder Zeile ein anderer Wert, mit der .VALUE Methode wird immer der feste Wert eingesetzt - die Funktion wird also "überschrieben". Je nachdem was man möchte, kann die eine oder andere Methode sinnvoller sein.
Bei grossen Tabelle mit vielen Zeilen ist Deine Methode etwas schneller als die .COPY Methode.
Salut, NoNet

Anzeige
Echt? AW: Ist auch OK
06.11.2012 09:59:43
Klaus
Bei grossen Tabelle mit vielen Zeilen ist Deine Methode etwas schneller als die .COPY Methode.
Ich beobachtete gerade das Gegenteil, siehe mein Eintrag im anderen Baum.
Grüße,
Klaus M.vdT.

Danke fuers Bescheid geben. Gruss owT
06.11.2012 10:11:05
hary
.

Zusatzfrage an Klaus
06.11.2012 10:20:54
hary
Hallo Klaus
Hab's es noch nicht getestet, aber in deinem ersten Code hast du doch zwei Schleifen drin.
Dass soll/geht schneller, als die Valueeintragung in den Bereich?
Werd ich mal bei zeiten testen.
gruss hary

Antwort 2 Schleifen AW: Zusatzfrage an Klaus
06.11.2012 10:24:11
Klaus
Hi,
die zweite Schleife ist aber aufgrund meiner doofheit drin, weil ich nicht an das "resize" gedacht habe. Die Frage hier ist nicht ".value = .value schneller als zwei schleifen?", die Frage ist ".value = .value schneller als copy pastespecial"!
Testen darfst du natürlich alles, bitte die Zeit-Ergebnisse hier posten!
Grüße,
Klaus M.vdT.

Anzeige
Ergebniss
06.11.2012 11:20:36
hary
Hallo Klaus & NoNet
So hab ich mal kurz getestet.
Vorgabe Tabelle1: 1500 Eintraege mit Menge jeweils 10
Zu beruecksichtigen, habe einen aelteren Com..
Klaus 1. Code : 333,1563 (nicht auf Resize umgeschrieben)
NoNet : 5,9375
hary : 3,4531
Matthias : Esc-Taste
gruss hary

dann scheint es einen Scheitelpunkt zu geben, ...
06.11.2012 11:58:42
Klaus
... bis zu dem .values schneller ist als Copy Pastespecial, denn in meinem Beispiel mit komplett gefüllter Spalte war .values langsamer.
Auf jedem Fall zeigt sich aber, dass der Verzicht auf verschachtelte Schleifen der Performance mehr als nur ein wenig zugute kommt! (ok, das wussten wir auch schon vorher).
Grüße,
Klaus M.vdT.
P.S.: Ich liebe dieses Forum! Das Problem ist schon seit Stunden gelöst, der Themenersteller hat sich ausgeklinkt und wir diskutieren und testen auf optimierungen im Sekundenbereich für Tabellengrößen jenseits jeder Realität. Wer nicht selbst programmiert oder excelt, muss uns kleine Gruppe hier für die größten Pendanten des Planeten halten :-)

Zeilen so oft duplizieren wie in Zelle steht
06.11.2012 09:27:34
Matthias
Hallo Marc
In Deinem Betreff hast Du geschrieben Zeilen duplizieren.
Daran habe ich mich mal gehalten.
Habe als Ziel mal Tabelle3 benutzt
In Zeile(1) stehen wie in Tabelle2 die Überschriften !
Option Explicit
Sub Marc()
Dim x&, Dupl&
Dim Loletzte&
Loletzte = Tabelle3.Cells(Rows.Count, 1).End(xlUp).Row
For x = 3 To 2 Step -1
Dupl = Tabelle1.Cells(x, 4)
Tabelle1.Rows(x).Copy
Tabelle3.Rows(Loletzte + 1 & ":" & Dupl + 1).Insert Shift:=xlDown
Next
Application.CutCopyMode = xlCut
End Sub
Das geht aber nicht mit einer .xlsx
Dazu musst Du eine .xls oder .xlsm benutzen.
Ich habe mal eine xls daraus gemacht
https://www.herber.de/bbs/user/82502.xls
Gruß Matthias
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige
Archiv - Verwandte Themen