• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Rijen onder elkaar plaatsen zodat er een draaitabel van gemaakt kan worden.

Status
Niet open voor verdere reacties.

djongste

Gebruiker
Lid geworden
12 mrt 2019
Berichten
11
De vorige keer ben ik hier goed geholpen, maar ik zit met de volgende uitdaging.

Ik ben bezig met een logboek voor sporters;
Het lukt me aardig deze op te zetten.
Ik heb een invoerblad waarin ze de gegevens kunnen invoeren en deze zet het met een macroknop op de goede plek achter de datum.
Nu wil ik leuke overzichtjes maken met hoeveel uur heb je getraind en hoeveel KM deze week tov vorige week.

Dit lukt best met een draaitabel en één reeks trainingen op een dag.
Maar soms trainen ze twee keer op een dag, dus dan staat er in een regel twee keer trainingsinformatie.
In de draaitabel splitst die deze ook, terwijl die juist alle info van het zelfde type training bij elkaar moet optellen.

Dit krijg ik niet goed in een draaitabel, dus ik wil het eigenlijk omzetten naar 1 kolom met datums, 1 kolom met alle activiteiten, 1 kolom met de trainingsduur en 1 kolom met aantal KM.
Bijgevoegd een afbeelding van hoe het ingedeeld is.
Kolommen H en O moeten dan bij elkaar gevoegd worden.

Knipsel Excelblad.JPG

Wie weet hebben jullie een goede oplossing hiervoor :)
 
Ja sorry Timshel,

Maar dat is inderdaad precies wat er moet gebeuren.
Echter ben ik een pannenkoek op het gebied van programmeren, dus ik kom hiermee nog net niet waar ik wil zijn.

In bijlage de excel ipv een afbeelding.
 

Bijlagen

  • Forum Logboek draaitabel.xlsx
    61,6 KB · Weergaven: 25
Helemaal goed, maar gezien het uitblijven van reacties is kennelijk niet duidelijk wat ermee moet gebeuren.

Geef dit dus (handmatig) ook nog aan in het voorbeeld voor een aantal rijen/kolommen.
 
Voeg een nieuw werkblad 'Uitvoer' in en draai de code
Code:
Sub tsh()
    Dim Br, Bq
    Dim i As Long, j As Long, k As Long
    
    With CreateObject("System.Collections.Arraylist")
        Br = Sheets("Logboek").Cells(1).CurrentRegion
        .Add Array("Datum", "RHR", "Slaapuren", "Gevoel", "Gewicht", "Type training", _
            "Omschrijving training", "Zin in?", "RPE1", "KM", "Gem HR")
        For i = 2 To UBound(Br)
            Bq = Array(Format(Br(i, 3), "m-d-yy"), Br(i, 4), Br(i, 5), Br(i, 6), "", "", "", "", "", "", "")
            For j = 0 To 1
                If Br(i, 8 + j * 7) = "" Then Exit For
                For k = 4 To 10
                    Bq(k) = Br(i, 4 + k + j * 7)
                Next
                .Add Bq
            Next
        Next
        Sheets("Uitvoer").Cells(1, 1).Resize(.Count, 11) = Application.Index(.ToArray, 0)
        Sheets("Uitvoer").Columns(11).NumberFormat = "h:mm:ss"
    End With
End Sub
 
Laatst bewerkt:
Bedankt Timshel,

Echt fijn dat je dit op hebt geschreven.
P.S. ik heb "Gewicht' er tussenuit gehaald, alles was een kolom verschoven.

Graag zou ik weten wat welke regel precies doet, zodat ik hem met de hand zelf kan aanpassen als er nog een kolom bij moet komen.

Wat zou ik bijvoorbeeld moeten wijzigen als ik behalve dat datums [Kolom C] ook de weeknummers [KOLOM A] wil meenemen naar het blad "uitvoer"?.
Ik heb geprobeerd bij .Add Array( "Week", toe te voegen en bij Bq = Array(Format( Br(i, 1) toe te voegen.
Maar dan krijg ik een foutmelding.

Wellicht dat je mij hiermee nog verder kan helpen?
 
Wat zou ik bijvoorbeeld moeten wijzigen als ik behalve dat datums [Kolom C] ook de weeknummers [KOLOM A] wil meenemen naar het blad "uitvoer"?.

Is allemaal maatwerk natuurlijk
Code:
Sub tsh()
    Dim Br, Bq
    Dim i As Long, j As Long, k As Long
    
    With CreateObject("System.Collections.Arraylist")
        Br = Sheets("Logboek").Cells(1).CurrentRegion
        .Add Array[COLOR="#FF0000"]("Week", [/COLOR]"Datum", "RHR", "Slaapuren", "Gevoel", "Gewicht", "Type training", _
            "Omschrijving training", "Zin in?", "RPE1", "KM", "Gem HR")
        For i = 2 To UBound(Br)
            Bq = Array([COLOR="#FF0000"]Br(i, 1), [/COLOR]Format(Br(i, 3), "m-d-yy"), Br(i, 4), Br(i, 5), Br(i, 6), "", "", "", "", "", "", "")
            For j = 0 To 1
                If Br(i, 8 + j * 7) = "" Then Exit For
                For k = [COLOR="#FF0000"]5 To 11[/COLOR]
                    Bq(k) = Br(i, [COLOR="#FF0000"]3[/COLOR] + k + j * 7)
                Next
                .Add Bq
            Next
        Next
        Sheets("Uitvoer").Cells(1, 1).Resize(.Count, [COLOR="#FF0000"]12[/COLOR]) = Application.Index(.ToArray, 0)
        Sheets("Uitvoer").Columns([COLOR="#FF0000"]12[/COLOR]).NumberFormat = "h:mm:ss"
    End With
End Sub
 
Die melding krijg ik niet, althans niet in je testfile.
Is er iets misgegaan met kopiëren en plakken van de code?
 
Oops, je had gelijk.

Dim Br, Bq stond 2 keer onder elkaar.

Bedankt dit werkt!
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan