Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1240to1244
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

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.

    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
    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
    Anzeige
    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.
    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.

    320 Forumthreads zu ähnlichen Themen

    Anzeige
    Anzeige
    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige