Uitsplitsen van rijen (normaliseren)

[Mauvan]

Ik heb een sheet (export van derden) waarin gegevens staan als volgt ongeveer:
uniek id - algemene gegevens - dagA - tijd1 - tijd2 - dagB - tijd1 - tijd2 - dagC enz.
Onder dagA, dagB, dagC bevindt zich een code.

Dit wil ik natuurlijk splitsen om er mee te kunnen werken in 2 werkbladen waarvan de 1e alleen de algemene gegevens bevat (plus uniek id).
Het tweede blad moet er dan uitzien als:
uniek id - dagindicatie - code - tijd1 - tijd2

Dagindicatie = gelijk aan kolomkop (resp. dagA, dagB etc.)
code = inhoud van wat er onder dagA etc. stond.

Vooral het overnemen van die kolomkop levert mij hoofdbrekens op. Ik zou het in VBA willen vatten.

Oh ja, het betreft Office2003. Zie bijgaand voorbeeld.Bekijk bijlage Map1.xls

Veel dank!

 

[Cobbe]

Voor dit werkblad werkt dat zo:

Maar je moet natuurlijk ALLE bereiken aanpassen voor in uw eigen bestand.

 

[Mauvan]

Ok Cobbe, ik snap de werkwijze, maar dan heb ik nog 2 problemen.
Eerste is dat ik liefst niet weet hoeveel rijen er in het eerste tabblad zitten. Als ik dat wel weet, moet ik dus het aantal keer 10 (kan wel 30.000 worden) moet kopieren in het 2e blad.
Tweede probleem is dat ik niet variabel kolom B kan vullen op basis van de bijbehorende kopregel in het eerste tabblad.

Ik heb al geprobeerd dit probleem in Access aan te pakken, maar daar is het helemaal lastig om het te automatiseren.

Nog suggesties? Dank voor zover in ieder geval.

 

[WHER]

Op basis van je tabblad "Gewenst" kom ik tot deze aanpak (ook met formules)

 

[snb]

Of een makrootje:

Sub snb()
  sn = Sheets("bron").Cells(1).CurrentRegion
  ReDim sq(10 * (UBound(sn) + 1), 4)
  
  For j = 2 To UBound(sn)
    For jj = 1 To 10
      sq(10 * (j - 2) + jj, 0) = sn(j, 1)
      sq(10 * (j - 2) + jj, 1) = sn(j, 5 + 3 * (jj - 1))
      sq(10 * (j - 2) + jj, 2) = sn(j, 6 + 3 * (jj - 1))
      sq(10 * (j - 2) + jj, 3) = sn(j, 7 + 3 * (jj - 1))
    Next
  Next
  
  Sheets("Bron").Cells(10, 1).Resize(UBound(sq) + 1, UBound(sq, 2) + 1) = sq
End Sub

 

[Mauvan]

Yes, snb, dit is (bijna) wat ik zoek. Geweldig.
Mis alleen de truc om die dagindicatie uit de kopregel er in te zetten. Die is belangrijk.

Ik probeer 't te doorgronden om daar zelf nog 's iets van onder de knie te krijgen.
Dank zover.

 

[Warme bakkertje]

Sub snb()
  sn = Sheets("bron").Cells(1).CurrentRegion
  ReDim sq(10 * (UBound(sn) + 1), 5)
  x = 1
  For j = 2 To UBound(sn)
    For jj = 1 To 10
      sq(10 * (j - 2) + jj, 0) = sn(j, 1)
      sq(10 * (j - 2) + jj, 1) = sn(j - x, 5 + 3 * (jj - 1))
      sq(10 * (j - 2) + jj, 2) = sn(j, 5 + 3 * (jj - 1))
      sq(10 * (j - 2) + jj, 3) = sn(j, 6 + 3 * (jj - 1))
      sq(10 * (j - 2) + jj, 4) = sn(j, 7 + 3 * (jj - 1))
    Next
    x = x + 1
  Next
  Sheets("Bron").Cells(10, 1).Resize(UBound(sq) + 1, UBound(sq, 2) + 1) = sq
End Sub

 

[Mauvan]

Mooi! Ik kan hier zeker wat mee.
De spreadsheet was een voorbeeld. Het echte werk is wat uitgebreider, maar ik kom er met dit in de pocket zeker wel uit. (enige programmeerervaring dateert alweer van een jaar of 15 geleden).

Dank snb (by the way: leuke site. daar kom ik nog wel vaker langs denk ik).
Dank Rudi.

 

[Mauvan]

Tenslotte

Toch nog een vraag.
Ik heb de macro als volgt aangepast:

Sub extract_routes_per_dag()
sn = Sheets("Deelnemers").Cells(1).CurrentRegion
ReDim sq(10 * (UBound(sn) + 1), 7)
x = 1
For j = 2 To UBound(sn)
For jj = 1 To 10
sq(10 * (j - 2) + jj, 0) = sn(j, 1)
sq(10 * (j - 2) + jj, 1) = sn(j - x, 19 + 5 * (jj - 1))
sq(10 * (j - 2) + jj, 2) = sn(j, 19 + 5 * (jj - 1))
sq(10 * (j - 2) + jj, 3) = sn(j, 20 + 5 * (jj - 1))
sq(10 * (j - 2) + jj, 4) = sn(j, 21 + 5 * (jj - 1))
sq(10 * (j - 2) + jj, 5) = sn(j, 22 + 5 * (jj - 1))
sq(10 * (j - 2) + jj, 6) = sn(j, 23 + 5 * (jj - 1))
Next
x = x + 1
Next
Sheets("Output").Cells(1, 1).Resize(UBound(sq) + 1, UBound(sq, 2) + 1) = sq
End Sub
​

Dus de output komt in een ander tabblad dan de brongegevens en begint op rij 2.
Nu wil ik eigenlijk de kolomkoppen op de 1e rij vastzetten, maar dat werkt niet. Dat wordt telkens gecleard. Hoe pas ik het in?
Dank alvast.

 

[Warme bakkertje]

Maar ik zie nergens in jouw macro dat je eerst oude resultaten wist alvorens nieuwe te plaatsen. Wat gebeurt er als de nieuwe resultaten kleiner zijn dan de oude ?
Je hebt dus de keuze dat je het te wissen bereik gaat bepalen vanaf Rij 2 ( maar dan moet je de laatst gebruikte rij en kolom gaan bepalen) of je wist het volledige werkblad en plaatst de kolomkoppen met 1 regeltje code telkenmale terug bij elke update.

with Sheets("Output")
    .cells.clear
    .cells(1).resize(,7)=split("Kop1|Kop2|Kop3|Kop4|Kop5|Kop6|Kop7","|")
    .Cells(2, 1).Resize(UBound(sq) + 1, UBound(sq, 2) + 1) = sq
end with

 

[Mauvan]

Ik heb de laatste 2 regels binnen With omgedraaid (als laatste 2 kopregels plaatsen):

  With Sheets("Output")
        .Cells.Clear
        .Cells(1, 1).Resize(UBound(sq) + 1, UBound(sq, 2) + 1) = sq
        .Cells(1).Resize(, 7) = Split("Kop1|Kop2|Kop3|Kop4|Kop5|Kop6|Kop7", "|")
  End With

en dan werkt het perfect.

Bedankt.

(weer wat geleerd)

 

[Warme bakkertje]

.Cells([COLOR="#FF0000"]2[/COLOR], 1).Resize(UBound(sq) + 1, UBound(sq, 2) + 1) = sq

Anders haal je het eerste resultaat van je matrix weg door de kolomkoppen te plaatsen.