Microsoft Excel

Herbers Excel/VBA-Archiv

Zeilen so oft duplizieren wie in Zelle steht

Betrifft: Zeilen so oft duplizieren wie in Zelle steht von: Marc
Geschrieben am: 06.11.2012 08:10:36

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

  

Betrifft: AW: Zeilen so oft duplizieren wie in Zelle steht von: guentherh
Geschrieben am: 06.11.2012 08:50:30

Hallo Marc
https://www.herber.de/bbs/user/82501.xlsm
Makro "Test" ausführen

Gruß,
Günther


  

Betrifft: AW: Zeilen so oft duplizieren wie in Zelle steht von: Klaus M.vdT.
Geschrieben am: 06.11.2012 08:50:47

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.


  

Betrifft: AW: Zeilen so oft duplizieren wie in Zelle steht von: Marc
Geschrieben am: 06.11.2012 09:20:31

Hallo,

wow, danke für das Super Script!! Konnte das ja sogar mit meinen Tabellenblattnamen verändern. Läuft super, danke dafür!!
Marc


  

Betrifft: Danke für die Rückmeldung! o.w.T. von: Klaus M.vdT.
Geschrieben am: 06.11.2012 09:25:32

.


  

Betrifft: bitte ändern: von: Klaus M.vdT.
Geschrieben am: 06.11.2012 09:44:54

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.


  

Betrifft: Nöö : SOO aggressiv bin ich nicht von: NoNet
Geschrieben am: 06.11.2012 09:50:43

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


  

Betrifft: @Klaus : Bei 65000 kommt mir die Galle hoch ;-) von: NoNet
Geschrieben am: 06.11.2012 09:29:19

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


  

Betrifft: /unterschrieben von: Klaus M.vdT.
Geschrieben am: 06.11.2012 09:40:14

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


  

Betrifft: und dann gibt es noch ... von: Rudi Maintaire
Geschrieben am: 06.11.2012 11:22:45

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


  

Betrifft: Genau DAS ist eine weitere der Unzulänglichkeiten von: NoNet
Geschrieben am: 06.11.2012 11:37:03

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


  

Betrifft: OK, Spezialfall: Wie geht das? von: Klaus M.vdT.
Geschrieben am: 06.11.2012 11:52:00

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.


  

Betrifft: Zeilen mengenmässig duplizieren : kurze Variante von: NoNet
Geschrieben am: 06.11.2012 09:23:00

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


  

Betrifft: schöne Variante! von: Klaus M.vdT.
Geschrieben am: 06.11.2012 09:30:05

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.


  

Betrifft: AW: Bitte um Meinung von: hary
Geschrieben am: 06.11.2012 09:48:19

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


  

Betrifft: subjektiv AW: Bitte um Meinung von: Klaus M.vdT.
Geschrieben am: 06.11.2012 09:57:27

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.


  

Betrifft: Ist auch OK von: NoNet
Geschrieben am: 06.11.2012 09:57:40

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


  

Betrifft: Echt? AW: Ist auch OK von: Klaus M.vdT.
Geschrieben am: 06.11.2012 09:59:43

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.


  

Betrifft: Danke fuers Bescheid geben. Gruss owT von: hary
Geschrieben am: 06.11.2012 10:11:05

.


  

Betrifft: Zusatzfrage an Klaus von: hary
Geschrieben am: 06.11.2012 10:20:54

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


  

Betrifft: Antwort 2 Schleifen AW: Zusatzfrage an Klaus von: Klaus M.vdT.
Geschrieben am: 06.11.2012 10:24:11

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.


  

Betrifft: Ergebniss von: hary
Geschrieben am: 06.11.2012 11:20:36

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


  

Betrifft: dann scheint es einen Scheitelpunkt zu geben, ... von: Klaus M.vdT.
Geschrieben am: 06.11.2012 11:58:42

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


  

Betrifft: Zeilen so oft duplizieren wie in Zelle steht von: Matthias L
Geschrieben am: 06.11.2012 09:27:34

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


 

Beiträge aus den Excel-Beispielen zum Thema "Zeilen so oft duplizieren wie in Zelle steht"