1 Kolom omzetten naar 800 rijen

[Elroy27]

Hoi,
Ik heb twee kolommen aan gegevens (zie bijlage). Het eerste groep gegevens van Kolom 1 moet uiteindelijk de kolomkop worden. Kolom twee moet onder de kolomkop in rijen komen (zie bijlage voorbeeld 2). In totaal gaat het om 800 van zulke groepen, dus niet iets wat je handmatig even met kopiëren en plakken doet.

Alle eerdere zoekacties via het net leverde mij niet meer op dan de aktie kopieren, plakken speciaal, Transporneren.........maar helaas, dit werkt niet zoals ik zou willen.

Kan iemand mij helpen!!!!!:
Bekijk bijlage VOORBEELDLIJST.xlsBekijk bijlage VOORBEELDLIJST 2.xls

 

[jempi10]

U kan misschien even vermelden dat u de vraag ook gesteld hebt in Worksheet.
En ik denk dat VBA een oplossing is, maar daar heb ik te weinig kaas van gegeten.
Succes.

 

[Warme bakkertje]

http://www.helpmij.nl/forum/showthread.php/739625-Transponeren-in-serie

Deze oplossing kan je makkelijk ombouwen naar jouw situatie.
Verwijder echter eerst alle lege rijen tussen elke groep.

 

[huijb]

@Elroy27 De volgende keer graag aangeven dat je je vraag ook op een ander Excel forum heb gesteld. Excel helpers zijn vaak op meedrere fora aanwezig en op deze manier zijn zij dubbel werk aan het doen. Dit geldt ook voor de evt. oplossing.

 

[Elroy27]

@Rudi 'Warme Bakketje',

Ik snap je post niet......

 

[Warme bakkertje]

In die vraag heb ik een oplossing geboden voor een soortgelijk probleem.
Het is een andere insteek dan bsalv op worksheet.nl(waar de vraag blijkbaar al verwijdert is aangezien ze daar een strengere aanpak hebben voor wat betreft crossposting).
Hij werkt met Areas, ik heb er Arrays van gemaakt in het werkgeheugen.
Ik heb de aanpassing eens voor mezelf gemaakt en ik kwam uit op 0,10...sec voor 800 groepen (18400 rijen). Dat is enkel tienden van seconden sneller dan de oplossing van bsalv en zeker sneller dan handmatig knippen en plakken :d

 

[Elroy27]

Beste Rudi,
Jou Excelkennis is duidelijk ver boven mijn begrip van Excel. Ik werk al enige jaren met Excel, dus ik weet wel wat.

Je geeft onder elke post de volgende opmerking: Er zijn geen domme vragen, enkel domme antwoorden , dus ik ga ervan uit dan je het niet erg vind als ik je vraag voor een stap voor stap uitleg. Hoe kan ik dit probleem aanpakken. Fijn om te horen dat het jou in ieder geval gelukt is.

Mvg,
Elroy

 

[Warme bakkertje]

Sub tst()
    't = Timer
    Dim sq(1 To 22, 1 To 850)
    j = 1: k = 1
    With Sheets("Blad1")
        sn = .Range("B1:B" & .Cells(Rows.Count, 2).End(xlUp).Row)
        For i = 1 To UBound(sn) Step 24
            For ii = 1 To 22
                sq(ii, j) = sn(k, 1)
                k = k + 1
            Next
            j = j + 1: k = k + 1
        Next
    End With
    With Sheets("Blad2")
        .Cells.ClearContents
        .Cells(1).Resize(, 22) = Split(Join(WorksheetFunction.Transpose(Blad1.Cells(1).Resize(22).Value), "|"), "|")
        .Cells(2, 1).Resize(UBound(sq, 2), 22) = WorksheetFunction.Transpose(sq)
        .Rows(1).EntireColumn.AutoFit
    End With
    'MsgBox Timer - t
End Sub

Je kan de lege tussenrijen laten staan in tegenstelling tot een eerder antwoord van mij.
Let er wel op dat de bladnamen overeenkomen met het origineel bestand.
Deze werkt enkel tot 850 groepen, anders moet je de 850 bovenaan de macro wijzigen in een ander (groter) getal.

 

[snb]

Macrootje:

Sub M_snb()
    sn = Sheets("Blad1").UsedRange
    
    For j = 1 To UBound(sn) Step 23
      Cells(j, 1).Resize(22).Name = "snb_1"
      Sheets("Blad2").Cells(j \ 23 + 2, 1).Resize(, 22) = Application.Transpose(Application.Index(sn, [row(snb_1)], 2))
    Next
End Sub

 

[Elroy27]

Ik heb helaas geen kennis van macro's..............
'k zou niet weten hoe bovenvermelde macro's in Excel toe te passen.

 

[snb]

Wat niet is kan komen:

zie: http://www.gratiscursus.be/Excel_2010/excelles085.html

 

[Warme bakkertje]

@ snb
De macro is een pak korter, maar ook een pak trager nl 17sec over 18400 rijen.

@ Elroy
In XL ALT+F11 ==> Invoegen ==> Module ==> Code plakken ==> terug naar XL ==> ALT+F8 ==> macronaam selecteren ==> Uitvoeren

 

[snb]

@WB

In die tijd kan TS zich VBA eigen maken...

 

[Warme bakkertje]

D'r zat een fout in mijn vorige macro. Deze zou correcte resultaten moeten weergeven.

Sub tst()
    t = Timer
    Dim sq()
    ReDim sq(1 To 22, 1000)
    j = 1
    With Sheets("Blad1")
        sn = .Range("B1:B" & .Cells(Rows.Count, 2).End(xlUp).Row)
        For i = 1 To UBound(sn) Step 23
            For ii = 1 To 22
                sq(ii, j) = sn(i + ii - 1, 1)
            Next
            j = j + 1
        Next
    End With
    ReDim Preserve sq(1 To 22, j)
    With Sheets("Blad2")
        .Cells.ClearContents
        .Cells(1).Resize(, 22) = Split(Join(WorksheetFunction.Transpose(Blad1.Cells(1).Resize(22).Value), "|"), "|")
        .Cells(2, 1).Resize(UBound(sq, 2), 22) = WorksheetFunction.Transpose(sq)
        .Rows(1).EntireColumn.AutoFit
        .Rows(2).EntireRow.Delete xlUp
    End With
    MsgBox Timer - t
End Sub

 

[snb]

@WB

Kun je dit alternatief dan eens testen ?

Sub M_snb()
    sn = Sheets("Blad1").UsedRange
    
    For j = 1 To UBound(sn) Step 23
       Sheets("Blad2").Cells(j \ 23 + 2, 1).Resize(, 22) = Application.Transpose(Application.Index(sn, evaluate("row(" & j & ":" & j+22 & ")"), 2))
    Next
End Sub

 

[Warme bakkertje]

@ snb

Weinig of geen verbetering.

 

[snb]

@WB

Wordt het geen tijd voor een snellere computer ?

Maar we hebben toch maar weer mooi 20 % aan VBA regels bespaard....