Database school aanpassen

[Felix32]

Beste forumleden,

Mijn vrouw zit in de ouderraad van de basisschool van onze kinderen en haar is gevraagd om 1500 kinderen in een excel bestand even anders neer te zetten op basis van een file die de school heeft geëxporteerd. Zij was dit heel netjes met de hand aan het doen. Nu dacht ik even slim te zijn en weet ik zeker dat het wel kan, maar ik loop na 2 avonden zwoegen nu ook vast.

Het gaat om het volgende:

De gegevens worden nu al volgt aangeleverd (verzonnen namen):


Nu is hetgeen wat het moet worden het volgende:


Een aantal zaken zijn dus veranderd:

1. De kopjes hoofdverzorger, leerlingnaam enz enz zijn verwijderd. Dit moet ook, want het staat er voor elk gezin opnieuw.
2. De gegevens van de kinderen zijn ineens horizontaal naast elkaar geplaatst.
3. De adresgegevens zijn verwijderd.
4. Bij meerdere kinderen staan de volgende kinderen ook weer in dezelfde rij.

Ik heb geprobeerd dit op te lossen met zoeken, selecteren, functies......maar om een lang verhaal kort te maken: het lukt mij gewoon echt niet.

Kan iemand mij een beetje op weg helpen. Het zal vast makkelijk zijn, maar ik zie het even niet.

Dank,

Felix

 

[VenA]

Mooie onleesbare plaatjes. Dit is een Excel forum plaats dan ook een Excel bestand. Zou ik denken

 

[Felix32]

Je hebt gelijk, vele malen makkelijker!

 

[VenA]

Bijzonder verhelderend voorbeeld........

Waarschijnlijk bedoel je zoiets waarbij ik de uitkomst in een tabelvorm heb gegoten. (Anders kan je, in mijn optiek, nog niets met de gegevens.)
Ik ben er vanuit gegaan dat er tussen elk blok aan gegevens een lege rij staat en er geen lege kolommen zijn anders werkt het natuurlijk niet.

Sub VenA()
Dim t As Long, j As Long, x, ar
With Sheets("Data")
  ReDim ar(.Columns(2).SpecialCells(2).Count, 7)
  For Each x In .Range("A1:A" & .Cells(Rows.Count, 1).End(xlUp).Row + 1).SpecialCells(2).Areas
    With x.CurrentRegion
      For j = 2 To .Rows.Count
        If .Cells(j, 2) <> "" Then
          ar(t, 0) = .Cells(2, 1)
          ar(t, 1) = .Cells(3, 1)
          ar(t, 2) = Split(.Cells(4, 1))(0)
          ar(t, 3) = Split(.Cells(4, 1))(1)
          ar(t, 4) = .Cells(j, 2)
          ar(t, 5) = CDate(.Cells(j, 3))
          ar(t, 6) = .Cells(j, 4)
          ar(t, 7) = .Cells(j, 5)
          t = t + 1
        End If
      Next j
    End With
  Next x
End With
Sheets("Resultaat").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(ar) + 1, UBound(ar, 2) + 1) = ar
End Sub

 

[Felix32]

Beste VenA,

Wow ! Dank hiervoor al, ik ben onder de indruk. Het was de bedoeling dat het nog net iets anders opgezet wordt, zoals in bijgevoegde file. De bovenste 2 ouders zijn dus al omgezet (de heer Bakker en mevr El Takkie (lekkere namen gekozen deze keer)...;-)

Zoals je ziet heeft Mevr El Takkie 2 kids en staan die nu naast elkaar, in plaats van onder elkaar. De volgorde van de gegevens van de kinderen is horizontaal wel steeds hetzelfde (naam, geb dat, geslacht, klas).

De gegevens daaronder (mevr Groentje en Dhr Jansen) moeten dus nog verwerkt worden (zo worden ze door school aangeleverd). De tekst van 'hoofdverzorger' komt wel steeds iedere keer terug. Het wisselt soms wel hoeveel regels er inderdaad tussen de ouders zit.

Leg ik het zo duidelijker uit?

Een meteen andere vraag: had ik dit ook op kunnen lossen zonder een Macro? Ik ben zelf alleen bekend met functies en dan alleen de hele basale (som, gemiddelde enz enz). Dat heb ik namelijk eerst geprobeerd, maar kwam er niet uit. Is een macro hier nu de truc?

Nogmaals dank !

Felix

 

[VenA]

De bijgevoegde file is net zo niets zeggend als de eerste. Dat je de regels per ouder/verzorger op één rij wilt hebben begrijp ik wel, maar is niet zinvol. Maak een voorbeeldje met op de eerste tab de gegevens zoals je deze aangeleverd krijgt (dit moet exact identiek zien) en op de twee tab het gewenste resultaat met de gegevens uit de eerste tab.

 

[Felix32]

Zie hier: eerst tab is zoals het aangeleverd wordt, tweede tab is zoals men wil dat het wordt (of het handig of juist is, daar ik ga mij niet aan branden).

 

[VenA]

Probeer het zo eens.

Sub VenA()
Dim t As Long, j As Long, x, ar
With Sheets("Gezinnen en leerlingen en NAW")
  ReDim ar(.Range("A1:A" & .Cells(Rows.Count, 1).End(xlUp).Row + 1).SpecialCells(2).Areas.Count, 16)
  For Each x In .Range("A1:A" & .Cells(Rows.Count, 1).End(xlUp).Row + 1).SpecialCells(2).Areas
    With x.CurrentRegion
      ar(t, 0) = .Cells(2, 1)
        For j = 2 To .Rows.Count
          If .Cells(j, 2) <> "" Then
            ar(t, j * 4 - 7) = .Cells(j, 2)
            ar(t, j * 4 - 6) = .Cells(j, 3)
            ar(t, j * 4 - 5) = .Cells(j, 4)
            ar(t, j * 4 - 4) = .Cells(j, 5)
          End If
        Next j
    End With
    t = t + 1
  Next x
End With
Sheets("Doelmap").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(ar) + 1, UBound(ar, 2) + 1) = ar
End Sub

 

[Felix32]

Fout 9 tijdens uitvoering:

Het subscript valt buiten het bereik

???

 

[VenA]

Werkt prima in het voorbeeldje.

 

[Felix32]

Geweldig !! Duizend maal dank !

Nog even de 'domme' vraag: had ik dit nu ook zelf gekund zonder een Macro. Tot eergisteren had ik namelijk nog nooit van een Macro gehoord......

 

[VenA]

Als je handig bent met matrixformules kan het misschien zonder macro.

 

[HSV]

Iets anders geschreven.

For Each x In .Range("A1:A" & .Cells(Rows.Count, 1).End(xlUp).Row + 1).SpecialCells(2).Areas
      ar(t, 0) = x(2, 1)
        For j = 2 To x.Rows.Count
          If x(j, 2) <> "" Then
            ar(t, j * 4 - 7) = x(j, 2)
            ar(t, j * 4 - 6) = x(j, 3)
            ar(t, j * 4 - 5) = x(j, 4)
            ar(t, j * 4 - 4) = x(j, 5)
          End If
        Next j
    t = t + 1
  Next x

 

[Felix32]

Nu ik hem definitief exporteer zie ik toch een foutje......

Als ik de laatste file gebruik van VenA, dan zie je dat sommige geboortedata rechts uitgelijnd worden. Toevallig zijn dit precies de geboortedata waarbij de dag en maand omgedraaid zijn (zie moeder file).

Hoe kan dit? Hebben jullie hier een oplossing voor. Graag als excel file plaatsen, een macro erin plakken, lijkt om een of andere reden nooit te werken.

Dank !

 

[HSV]

Als je cel C4 even aanpast in 30-06-2009 moet het lukken; juni heeft maar 30 dagen.

 

[Felix32]

GELUKT !!

Dank aan alleen die geholpen hebben

 

[snb]

Ik zou het zo doen:

Sub M_snb()
   With Sheets("Gezinnen en leerlingen en NAW")
        sn = .UsedRange
        ReDim sp(.Columns(1).SpecialCells(2).Areas.Count, 17)
   End With
   y = -1
   
   For j = 1 To UBound(sn)
     If Left(LCase(sn(j, 1)), 14) = "hoofdverzorger" Then
        y = y + 1
        sp(y, 0) = sn(j + 1, 1)
        For jj = 1 To 4
          For jjj = 2 To 5
            sp(y, 4 * (jj - 1) + jjj - 1) = sn(j + jj, jjj)
          Next
        Next
     End If
  Next

  Sheets("Doelmap").Cells(10, 1).Resize(UBound(sp), UBound(sp, 2)) = sp
End Sub