Checkbock vraag verwerken tot draaitabel

[LeoBoonie]

Goede middag,

Als onderdeel van mijn werkzaamheden heb ik een select aantal leveranciers gevraagd een digitale vragenlijst in te vullen.

Op school maakte in altijd gebruik van SPSS voor het analyseren van mijn resultaten, maar mijn huidige werkgever wil dit programma niet aanschaffen. Daarbij is hij fan van draaitabellen in Excel. Zodoende dat ik in Excel 2010 ben begonnen.

Nu loop ik bij het verwerken van de resultaten tegen het volgende aan:
Het enquête programma geeft iedere respondent zijn eigen rij en plaatst vervolgens de antwoorden binnen een Checkbock vraag(multiple choicevraag waarbij meerdere antwoorden tegelijk gekozen kunnen worden) in aparte kolommen. Nou wil ik door middel van een draaitabel per leverancier de resultaten per vraag inzichtelijk maken. Om dit te kunnen doen heb ik begrepen dat de antwoorden per vraag onder elkaar moeten staan in plaats van naast elkaar (als ik het goed heb begrepen).

Maar hoe krijg ik dit op correcte wijze en zonder tabbladen te kopiëren, de overbodige cellen te verwijderen en weer terug te plakken in het origineel voor elkaar?

Onderstaand een document met een voorbeeld van wat ik bedoel.

Bekijk bijlage Voorbeeld.xlsx

Ik hoop dat jullie me kunnen helpen.

Alvast bedankt,


Leo

 

[VenA]

Door gebruik te maken van een macro kan je vrij eenvoudig de data transponeren naar een tabel in de juiste vorm. In het voorbeeld mis ik in de tab 'Grove data' iets wat het kenmerk heeft van een een contract. Dus deze kolom blijft leeg.

Sub VenA()
Dim j As Long, jj As Long, t As Long, ar, ar1
  With Sheet3.ListObjects(1).DataBodyRange
    ar = .Value
    ReDim ar1(.Cells.SpecialCells(2).Count - (3 * UBound(ar)), 4)
  End With
  For j = 1 To UBound(ar)
    For jj = 2 To UBound(ar, 2) - 2
      If ar(j, jj) <> vbNullString Then
        ar1(t, 0) = ar(j, 1)
        ar1(t, 1) = ar(j, jj)
        'ar1(t, 2) = ar(j, ?) Waar staat het contract?
        ar1(t, 3) = ar(j, 18)
        ar1(t, 4) = ar(j, 19)
        t = t + 1
      End If
    Next jj
  Next j
  With Sheet2.ListObjects(1)
      If .DataBodyRange Is Nothing Then .ListRows.Add
      .DataBodyRange.Resize(UBound(ar1), UBound(ar1, 2) + 1) = ar1
  End With
End Sub

 

[Leotaxi]

Welkom op het forum Leo


mvg
Leo

 

[LeoBoonie]

Ontzettend bedankt VenA!

Dit is een goed startpunt om verder uit te bouwen in mijn bronbestand. Zie alleen dat ik waarschijnlijk eerst kennis moet gaan maken met de ''programmeertaal''.

In ieder geval ontzettend bedankt voor de zet in de goede richting