Overzicht transponeren m.b.v. een macro

[Purrel]

Beste mensen,

hopelijk (en ook waarschijnlijk) bevindt er zich iemand op dit nuttige forum die me kan helpen of in elk geval een duwtje in de juiste richting kan geven.

Ik heb een Excel-bestand ontvangen waarbij bepaalde informatie per maand wordt weergegeven. Echter al deze maanden staan apart onder elkaar. Daardoor is de lengte van de rijen steeds anders en dat maakt mijn werk erg lastig.

Ik heb een excel-bestand bijgesloten met een vereenvoudigde weergave van mijn probleem. Op blad1 staan dus een x-aantal namen (kan variëren) met daarachter een aantal uur per datum. Elke datum is dus een aparte kolom. Soms staat er niks en soms ook 0. Nu zou ik al deze maanden in net overzicht willen onderbrengen met behulp van een macro, waarbij de datum niet meer in de kolom maar in de rij wordt getoond (als het ware dus getransponeerd).

Ik hoop dat mijn probleem/vraagstelling duidelijk genoeg is. Ik denk dat mijn voorbeeld-bestand meer duidelijk maakt. Wie o wie kan me helpen? In elk geval al vast bedankt voor jullie moeite!

Bekijk bijlage Voorbeeld.xls

 

[WHER]

Met een macro-gebaseerde aanpak kan ik je niet helpen, maar misschien geeft deze formule-gebaseerde aanpak je een duwtje in de goede richting.
Helaas is de layout van je gegevens zodanig dat zelfs voor dit vereenvoudigde voorbeeld een tamelijk ingewikkelde aanpak nodig is. Blijft dus de vraag of dit werkbaar is in een groter bestand.

 

[sylvester-ponte]

hallo Purrel

met zoiets moet het lukken

Sub Omzetten()
    'deze 2 regels moet je misschien zelf aanpassen
    Dim BeginTabel As Range: Set BeginTabel = Range("Blad1!A1")    'links boven oorspronkelijke tabel
    Dim Naar As Range: Set Naar = Range("Blad2!A18")             'hier komt de nieuwe tabel
    
    Naar.Parent.UsedRange.Offset(Naar.Row - 1, Naar.Column - 1).ClearContents
    Naar(1, 1) = "Naam": Naar(1, 2) = "BSN": Naar(1, 3) = "Datum": Naar(1, 4) = "Aantal"
    Set Naar = Naar(2, 1)                                       'hier begint je nieuwe invoer
    Dim Kolom As Integer
    Dim Van As Range: Set Van = BeginTabel
    Dim DatumRij As Range: Set DatumRij = BeginTabel
    Do
        Set Van = Van(2, 1)
        If Van = "" Then
            Set Van = Van(3, 1)
            Set DatumRij = Van(0, 1)
            If DatumRij = "" Then Exit Sub 'als deze rij leeg is dan stoppen we
        End If
        For Kolom = 3 To 34
            If Van(1, Kolom) > 0 Then
                Naar(1, 1) = Van(1, 1)
                Naar(1, 2) = Van(1, 2)
                Naar(1, 3) = DatumRij(1, Kolom): Naar(1, 3).NumberFormat = "m/d/yyyy"
                Naar(1, 4) = Van(1, Kolom)
                Set Naar = Naar(2, 1)
            End If
        Next Kolom
    Loop
End Sub

groet sylvester