Export database (meerdere regels per record) omzetten naar Excel

[krullenbol]

Dag Excel-ers,
Informatie per record bestaat telkens uit 6 regels export uit database, deze wil ik in Excel samenvoegen naar normale 'horizontale' tabel.
Dacht dat snel te doen met een draaitabel, of met transponeren, maar krijg het maar niet werkend.
Ik hoop dat dit voor sommige hier gesneden koek is.... ;-)
Links zie je de gegevens vanuit de database, rechts het gewenste resultaat.

Bedankt alvast.


Bekijk bijlage Gegevens omzetten.xlsx

 

[JeanPaul28]

met vba

 

[JEC.]

Andere code maar doet hetzelfde (wel sneller)

Sub jv()
 For i = 2 To Cells(Rows.Count, 4).End(xlUp).Row Step 6
  j = j + 1
  Cells(j + 1, 6).Resize(, 5) = Application.Transpose(Cells(i, 4).Resize(5))
 Next
End Sub

 

[krullenbol]

Zeer bedankt voor de reacties, die van JeanPaul28 werkt in ieder geval prima.
Ga hem aanpassen voor eigen gebruik.
Toch meer met VBA gaan doen...

 

[JEC.]

Als je echt veel data hebt zou ik voor deze gaan. Gaat veel en veel sneller

Sub jvveer()
jv = Cells(1).CurrentRegion
 ReDim ar(UBound(jv), 4)
   For i = 2 To UBound(jv) Step 6
     ar(j, 0) = jv(i, 4)
     ar(j, 1) = jv(i + 1, 4)
     ar(j, 2) = jv(i + 2, 4)
     ar(j, 3) = jv(i + 3, 4)
     ar(j, 4) = jv(i + 4, 4)
     j = j + 1
   Next
Cells(2, 6).Resize(UBound(ar), 5) = ar
End Sub

 

[HSV]

@jveer,

Als je het rode gedeelte erachter plaatst krijg je werkelijk true en false in de Ned. versie.

ReDim ar(UBound(jv), 4) [COLOR=#ff0000]as string[/COLOR]

Plus sneller.

 

[JEC.]

Ahh thnx, was me niet eens opgevallen

 

[pixcel]

Toch meer met VBA gaan doen...

Of minder, door Power Query te gebruiken. Deze transformatie definieer je met een paar muiskliks.

 

[snb]

@JVeer

Sub M_snb()
   sn = Cells(1).CurrentRegion.Resize(, 6)
   
   For j = 2 To UBound(sn)
     If j < 8 Then sn((j - 2) \ 6 + 1, (j - 2) Mod 6 + 1) = sn(j, 2)
     sn((j - 2) \ 6 + 2, (j - 2) Mod 6 + 1) = sn(j, 4)
   Next
   
   Cells(10, 6).Resize(j \ 6 + 1, UBound(sn, 2)) = sn
End Sub

 

[JEC.]

@snb, mooi!

De leesbaarheid vind ik er persoonlijk wel wat op achteruitgaan.

 

[snb]

Te ondervangen met:

Sub M_snb()
   sn = Cells(1).CurrentRegion.Resize(, 6)
   
   For j = 2 To UBound(sn)
     x = (j - 2) \ 6 + 1
     y = (j - 2) Mod 6 + 1

     If x = 1 Then sn(x,y) = sn(j, 2)
     sn(x + 1, y) = sn(j, 4)
   Next
   
   Cells(10, 6).Resize(x, UBound(sn, 2)) = sn
End Sub

 

[JEC.]

:thumb::thumb:

Edit: Uit nieuwsgierigheid de snelheidstest even gedaan. Het is een honderdste sneller op 1600 regels