Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Forumthread: Zeilen je nach Wert in Zelle duplizieren

Zeilen je nach Wert in Zelle duplizieren
Ralf
Hallo Miteinander,
ich habe folgendes Problem.
Ich habe eine Tabelle, die von A1:F500 mit Inhalten gefüllt ist.
In A1:A500 stehen Zahlenwerte. Entsprechend dieser Zahl soll die Zeile kopiert werden (Steht 900 darin, soll diese Zeile 900 mal dubliziert werden usw.)
Hatte hierfür schon einmal ein Makro nur habe ich dieses für maximal 15-20.000 Endzeilen benuzt.
In dem aktuellen Fall komme ich auf ca 450.000 Zeilen am Ende.
Hier der aktuelle Code:
  • 
    Sub ZeilenGenerieren()
    Application.ScreenUpdating = False
    AA = 1
    Do While AA 

  • kennt jemand eine effektivere und schnellere Lösung?
    Wäre über jede Verbesserung dankbar.
    Vielen Dank im Voraus
    Ralf B.
    Anzeige

    6
    Beiträge zum Forumthread
    Beiträge zu diesem Forumthread

    Betreff
    Benutzer
    Anzeige
    AW: Zeilen je nach Wert in Zelle duplizieren
    21.12.2011 11:50:45
    Rudi
    Hallo,
    teste mal:
    Sub xxxx()
    Dim lngCounter As Long, lngRow As Long, lngCol As Long, lngArr As Long
    Dim arr(), vntTmp
    ReDim arr(1 To Application.Sum(Columns(1)), 1 To 6)
    For lngRow = 1 To Cells(Rows.Count, 1).End(xlUp).Row
    For lngCounter = 1 To Cells(lngRow, 1)
    lngArr = lngArr + 1
    vntTmp = Cells(lngRow, 1).Resize(, 6)
    For lngCol = 1 To 6
    arr(lngArr, lngCol) = vntTmp(1, lngCol)
    Next
    Next
    Next
    With Worksheets.Add
    .Cells(1, 1).Resize(lngArr, 6) = arr
    End With
    End Sub
    

    Gruß
    Rudi
    Anzeige
    AW: Zeilen je nach Wert in Zelle duplizieren
    21.12.2011 12:34:57
    Ralf
    Hallo Rudi,
    vielen Dank für deine Hilfe. Passt perfekt und ist um längen schneller als die alte.
    Was muss ich ändern um in Zeile 2 zu beginnen? Müsste dann meine Titelzeile nicht immer vorher löschen ;-)
    Gruß Ralf
    For lngRow = 2 To Cells(... owT
    21.12.2011 12:37:09
    Rudi
    AW: For lngRow = 2 To Cells(... owT
    21.12.2011 12:47:15
    Ralf
    Hallo Rudi,
    das habe ich durch versuchen auch schon hinbekommen.
    Habe mich vieleicht Falsch ausgedrückt. Ich meinte, dass in der neu angelegten Tabelle die Titelzeile ebenfalls vorhanden ist, da ich diese für einen Serienbrief benötige.
    Ist aber nicht weiter schlimm (Ist ja händisch ruck zuck rüberkopiert)
    Nochmals vielen Dank und ein Kompliment ans Forum. Es ist immer wieder erfreulich wie einem hier geholfen wird.
    Gruß Ralf B.
    Anzeige
    mit Überschrift
    21.12.2011 13:07:40
    Rudi
    Hallo,
    dann so:
    Sub xxxx()
    Dim lngCounter As Long, lngRow As Long, lngCol As Long, lngArr As Long
    Dim arr(), vntTmp
    vntTmp = Cells(1, 1).CurrentRegion
    ReDim arr(1 To Application.Sum(Columns(1)) + 1, 1 To UBound(vntTmp, 2))
    'Überschrift
    lngArr = lngArr + 1
    For lngCol = 1 To UBound(vntTmp, 2)
    arr(lngArr, lngCol) = vntTmp(1, lngCol)
    Next lngCol
    'Datensätze
    For lngRow = 2 To UBound(vntTmp)
    For lngCounter = 1 To vntTmp(lngRow, 1)
    lngArr = lngArr + 1
    For lngCol = 1 To UBound(vntTmp, 2)
    arr(lngArr, lngCol) = vntTmp(lngRow, lngCol)
    Next lngCol
    Next lngCounter
    Next lngRow
    With Worksheets.Add
    .Cells(1, 1).Resize(UBound(arr), UBound(arr, 2)) = arr
    End With
    End Sub
    

    Hab noch ne Schüppe Kohlen drauf gelegt. Sollte jetzt schneller sein.
    Gruß
    Rudi
    Anzeige
    AW: mit Überschrift
    21.12.2011 13:58:37
    Ralf
    Absolut Perfekt!!!
    jetzt ist ja sogar die komplette Zeile drin :-)
    Wärst du in der Nähe, wäre jetzt ein Bier fällig!
    Danke nochmals
    Ralf B.
    ;

    Forumthreads zu verwandten Themen

    Anzeige
    Anzeige
    Anzeige
    Anzeige
    Entdecke relevante Threads

    Schau dir verwandte Threads basierend auf dem aktuellen Thema an

    Alle relevanten Threads mit Inhaltsvorschau entdecken
    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Entdecke mehr
    Finde genau, was du suchst

    Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

    Suche nach den besten Antworten
    Unsere beliebtesten Threads

    Entdecke unsere meistgeklickten Beiträge in der Google Suche

    Top 100 Threads jetzt ansehen
    Anzeige