• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Meerdere teksten dubliceren onder elkaar

Status
Niet open voor verdere reacties.
G

gertvn

Gebruiker
Lid geworden
3 okt 2016
Berichten
44
Beste Forumleden/specialisten.

Ik heb een aantal Excel lijsten met tussen de 2 en 10 kolommen met verschillende gegevens per rij, het kan zijn dat er maar 3 kolomen in gevuld zijn en de rest is dan leeg.
Ik moet nu an elke rij de gegevens dupliceren het aantal verschilt dan ook weer per excel lijst, ik ga deze Excellijst in mijn een grafisch pakket gebruiken en moeten de regels per rij erin staan dus als ik 5 keer een woord heb staan dan moet dat woord 5 keer onder elkaar staan.

In het voorbeeld zie je in het invulblad de gegevens staan (tekst 1 t.m tekst 10) in kolom M 2 zou ik dan graag het aantal willen invullen (in het voorbeeld 5 keer) waardoor er in het uitkomst tabblad van elke enkele regel er dan 5 onder elkaar staan. zoals hier onder en in het voorbeeld blad.

Voorbeeld invul blad

QR012 WIW515 Aap Noot appel Peer Peer 01 appel 05 WWW intel
QR013 WIW516 Aap 12 Noot 09 appel Peer Peer 02 appel 06 WWW intel 01
QR014 WIW517 Aap Noot appel Peer Peer 03 appel 07 WWW intel 02

Deze regels heb ik 5 keer nodig zou dit de uitkomt moeten worden
Tekst 1 Tekst 2 Tekst 3 Tekst 4 Tekst 5 Tekst 6 Tekst 7 Tekst 8 Tekst 9 Tekst 10
QR012 WIW515 Aap Noot appel Peer Peer 01 appel 05 WWW intel
QR012 WIW515 Aap Noot appel Peer Peer 01 appel 05 WWW intel
QR012 WIW515 Aap Noot appel Peer Peer 01 appel 05 WWW intel
QR012 WIW515 Aap Noot appel Peer Peer 01 appel 05 WWW intel
QR012 WIW515 Aap Noot appel Peer Peer 01 appel 05 WWW intel
QR013 WIW516 Aap 12 Noot 09 appel Peer Peer 02 appel 06 WWW intel 01
QR013 WIW516 Aap 12 Noot 09 appel Peer Peer 02 appel 06 WWW intel 01
QR013 WIW516 Aap 12 Noot 09 appel Peer Peer 02 appel 06 WWW intel 01
QR013 WIW516 Aap 12 Noot 09 appel Peer Peer 02 appel 06 WWW intel 01
QR013 WIW516 Aap 12 Noot 09 appel Peer Peer 02 appel 06 WWW intel 01
QR014 WIW517 Aap Noot appel Peer Peer 03 appel 07 WWW intel 02
QR014 WIW517 Aap Noot appel Peer Peer 03 appel 07 WWW intel 02
QR014 WIW517 Aap Noot appel Peer Peer 03 appel 07 WWW intel 02
QR014 WIW517 Aap Noot appel Peer Peer 03 appel 07 WWW intel 02
QR014 WIW517 Aap Noot appel Peer Peer 03 appel 07 WWW intel 02

Ik hoop dat er iemand kan helpen met deze vraag :-) want knippen plakken van deze bestanden is erg veel werk :-)

Alvast bedankt voor het meedenken
 

Bijlagen

Voor office 365

Code: 
=INDEX(Invulblad!A2:J7;REEKS(AANTALARG(Invulblad!A2:A7)*Invulblad!M2;1;1;1/Invulblad!M2);KOLOM(A2:J2))
 
Laatst bewerkt:
Kan ook met Power Query

Code: 
let
    Source = Excel.CurrentWorkbook(){[Name="Tabel1"]}[Content],
    repeat = Table.AddColumn(Source, "Repeat", each {1..Tabel3[aantal per regel]{0}}),
    exprepeat = Table.ExpandListColumn(repeat, "Repeat"),
    dltrepeat = Table.RemoveColumns(exprepeat,{"Repeat"})
in
    dltrepeat
 

Bijlagen

Nog een variant met een macro, maar dan met gebruik van arrays. Alles wordt in één keer weggeschreven.

Kan ook met een oneliner als je een Excel formule omzet naar VBA.

Code: 
Sub jec()
 Dim ar As Variant, sq As Variant
 Dim i As Long, j As Long
 
 With Sheets("Invulblad")
   ar = .Cells(1).CurrentRegion
   ReDim sq(1 To (UBound(ar) - 1) * .[M2], 1 To 10)
   For i = 1 To UBound(sq)
      For j = 1 To 10
        sq(i, j) = ar((i - 1) \ .[M2] + 2, j)
      Next
   Next
   Sheets("UITKOMST").Cells(2, 1).Resize(i - 1, 10) = sq
 End With
End Sub
 
Laatst bewerkt:
Nog een duit.

Code: 
Sub hsv()
Dim sv, hs, a As String, i As Long, s0 As String
 sv = Blad1.Cells(1).CurrentRegion
 a = Blad1.[M2]
        For i = 1 To UBound(sv)
         s0 = s0 & IIf(i = 1, i, Replace(String(a, " "), " ", " " & i))
        Next
     hs = Split(s0)
  Blad2.Cells(1).Resize(UBound(hs) + 1, UBound(sv, 2)) = Application.Transpose(Application.Index(sv, hs, Evaluate("row(1:" & UBound(sv, 2) & ")")))
End Sub
 
Zonder loop

Code: 
Sub jec()
 Dim ar
 With Blad1.Range("A2:J" & Blad1.Range("A" & Rows.Count).End(xlUp).Row)
   ar = Application.Index(.Value, Evaluate("int((row(1:" & .Rows.Count * Blad1.[M2] & ")-1)/'Invulblad'!M2)+1"), [transpose(row(1:10))])
   Blad2.Cells(2, 1).Resize(UBound(ar), UBound(ar, 2)) = ar
 End With
End Sub
 
Keurig,

Ik zou starten op rij 1 en de evaluate beginnen op 5.

Code: 
With Blad1.cells(1).currentRegion
   ar = Application.Index(.Value, Evaluate("int((row(5:" & .Rows.Count * Blad1.[M2] & ")-1)/'Invulblad'!M2)+1"), [transpose(row(1:10))])
   Blad2.Cells(1).Resize(UBound(ar), UBound(ar, 2)) = ar
 End With
 
Dat kan ook maar dan moet je de 5 in de evaluatie regel ook variabel maken.
Het aantal te dupliceren regels kan afwijken.

Code: 
 With Blad1.Cells(1).CurrentRegion
   ar = Application.Index(.Value, Evaluate("int((row(" & Blad1.[M2] & ":" & .Rows.Count * Blad1.[M2] & ")-1)/'Invulblad'!M2)+1"), [transpose(row(1:10))])
   Blad2.Cells(1).Resize(UBound(ar), UBound(ar, 2)) = ar
 End With
 
Beste forum leden,

Iedereen bedankt voor het meedenken, ik kan hiermee aan de slag:thumb:.

Aangezien ik zelf niet goed ben in het opmaken van Excel bestanden met macro's heb ik het voorbeeld bestand van emields en JEC gebruikt en deze werken perfect met wat ik wil.
De andere ga ik zeker proberen of ik ze werkend krijg zodat ik er in ieder geval weer wat van opsteek en misschien lukt het me dan wel om zelf macro's in te zetten :d.

Nogmaals bedankt:thumb::thumb:
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan