van een kolom van vier rijen naar een rij met vier kolommen

[PenningThor]

Het volgende probleem:

Ik heb een spreadsheet met data uit onze vrijwilligersmodule. Hierin staan per rij de naam van de vrijwilliger met de taak die hij/zij uitgevoerd heeft met een taakcode en het aantal uren. Een lid kan meerdere taken uitvoeren en heeft dan ook in dit spreadsheet meerdere rijen.

Ik zou graag een volgende indeling hebben van dit sheet:
per rij de volgende kolommen: roepnaam, tussenvoegsel, achternaam, volledig adres, postcode, plaats en dan de volgende kolommen met taken die deze persoon heeft uitgevoerd.

Zie bijlage en het voorbeeld van een van onze leden met vier taken

Ik hoor graag van jullie


*knip*

 

[VenA]

Ooit al eens iets meegekregen over de wet op privacy? Blijkbaar niet.

 

[mastermindzh]

Ik heb de bijlage uit voorzorg maar weggehaald aangezien er inderdaad veel persoonlijke info in staat.

m.v.g
Rick van Lieshout

 

[HSV]

Stond toevallig nog op Pc (ik zal het verwijderen).

Sub hsv()
Dim sv, a, b(2), i As Long, j As Long
Application.ScreenUpdating = False
sv = Sheets("blad1").Cells(1).CurrentRegion
With CreateObject("scripting.dictionary")
For i = 2 To UBound(sv)
 a = .Item(sv(i, 6) & "|" & sv(i, 7) & "|" & sv(i, 8) & "|" & sv(i, 9) & "|" & sv(i, 10) & "|" & sv(i, 11) & "|" & sv(i, 12) & "|" & sv(i, 13) & "|" & sv(i, 14) & "|" & sv(i, 15))
     If IsEmpty(a) Then a = b
        a(0) = sv(i, 6) & "|" & sv(i, 7) & "|" & sv(i, 8) & "|" & sv(i, 9) & "|" & sv(i, 10) & "|" & sv(i, 11) & "|" & sv(i, 12) & "|" & sv(i, 13) & "|" & sv(i, 14) & "|" & sv(i, 15)
        a(1) = a(1) & "~" & sv(i, 3)
        a(2) = a(2) & "~" & sv(i, 4)
     .Item(sv(i, 6) & "|" & sv(i, 7) & "|" & sv(i, 8) & "|" & sv(i, 9) & "|" & sv(i, 10) & "|" & sv(i, 11) & "|" & sv(i, 12) & "|" & sv(i, 13) & "|" & sv(i, 14) & "|" & sv(i, 15)) = a
Next i
ReDim arr(.Count, 1)
  For i = 0 To .Count - 1
    For j = 1 To UBound(Split(Join(.Item(.keys()(i))), "~")) / 2
      arr(i, 0) = arr(i, 0) & "|" & Split(Join(.Item(.keys()(i))), "~")(j) & "|" & Split(Join(.Item(.keys()(i))), "~")(j + UBound(Split(Join(.Item(.keys()(i))), "~")) / 2)
    Next j
      arr(i, 0) = Split(Join(.Item(.keys()(i))), "~")(0) & arr(i, 0)
  Next i
   Sheets("blad2").Cells(1).Resize(.Count) = arr
   Sheets("blad2").Columns(1).TextToColumns , 1, , , , , , , -1, "|"
End With
End Sub