Rijen in kolom herhalen

[stefano]

Van een tabel met unieke waarden in kolom A dien ik elke rij x keer te herhalen. (het totaal aantal unieke waarden in de tabel is ongeveer 15.000)

stel x= 3

tabel:

1
2
3

zou dan worden

1
1
1
2
2
2
3
3
3

Heeft iemand een idee hoe ik dat 'foutloos' zou kunnen bekomen?

 

[JEC.]

Hier staan meerdere oplossingen

https://www.helpmij.nl/forum/showth...dubliceren-onder-elkaar?highlight=Power+query

 

[AHulpje]

Als het een eenmalige actie is kopieer en plak dan alle 15000 rijen twee keer onder de voorgaande 15000 rijen en sorteer daarna je werkblad.

 

[stefano]

En ik heb er eentje uitgepikt en aangepast. Ik ging voor 50 rijen en 15 'herhalingen'. Na 53 seconden was de nieuwe tabel een feit.

hartelijk dank !

Sub Rechthoek1_Klikken()
With Sheets("UITKOMST")
.[a2:a100000].ClearContents
For Each cl In Range("a2:a" & [a10000].End(xlUp).Row)
    For i = 1 To [m2]
      cl.Resize(, 10).Copy .[a1000].End(xlUp).Offset(1)
    Next
Next
End With
[m2].Select
End Sub

 

[JEC.]

Dan heb je wel de traagste uitgekozen

 

[stefano]

Geduld is een schone deugd !!

dank je wel.

 

[AHulpje]

In 0,16 seconden, 1000 rijen, 26 gevulde kolommen, 25 x herhalen:

Sub Herhalen()
    Application.ScreenUpdating = False
    starttime = Timer
    Rows("1:1000").Copy
    For i = 1 To 25
        Range("A" & i * 1000 + 1).Select
        ActiveSheet.Paste
    Next
    With ActiveWorkbook.Worksheets("Uitkomst").Sort
        .SortFields.Add2 Key:=Range("A:A")
        .SetRange Range("A:Z")
        .Header = xlNo
        .Apply
    End With
    Application.ScreenUpdating = True
    MsgBox Timer - starttime
End Sub

 

[JEC.]

Toch win je het niet van deze evaluate regel

Sub jec()
 Dim ar, f As Long
 f = 25
 With Sheets("Uitkomst").Range("A2", Sheets("Uitkomst").Range("A" & Rows.Count).End(xlUp))
    ar = Application.Index(.Value, Evaluate("int((row(1:" & .Rows.Count * f & ")-1)/" & f & ")+1"))
   .Parent.Cells(2, 1).Resize(UBound(ar)) = ar
 End With
End Sub

 

[snb]

Sub M_snb()
  [a1:A750] = [index(int((row(1:750)-1)/15)+1,)]
End Sub

of

Sub M_snb()
  ReDim sn(750, 0)

  For j = 0 To UBound(sn)
    sn(j, 0) = j \ 15
  Next

  Range("A1:A750") = sn
End Sub

 

[AHulpje]

@JEC & snb

Geen van jullie macro's doet wat hij moet doen, namelijk de volledige rijen herhalen.
Dus heb ik nog steeds gewonnen

 

[JEC.]

Als je vanaf A2 begint te nummeren van 1 t/m 10 en daarna de macro runt, zie je dat de output in kolom B gewoon klopt

 

[AHulpje]

@JEC

Je macro is beslist supersnel, met 1000 rijen en 25x in 0,03 seconden.
Maar doet volgens mij niet precies wat TS vraagt, namelijk de hele rij herhalen en niet alleen kolom A tig keer naar kolom B.
Maar snel is ie!

 

[snb]

@AH

Iemand die 'select' gebruikt in VBA verliest immer.

 

[JEC.]

Even de reactie van ts afwachten dan maar