Meerdere kolommen reduceren tot 1 kolom

[Grootlicht]

Hallo allen,

Wie-o-wie kan mij met het volgende probleem helpen. Ik heb een excelbestand waarin per individu (rij) informatie is opgenomen over meerdere jaren (kolommen).

Dus stel:

Naam----Inkomen 2006----Inkomen 2007----Inkomen 2008 etc
Jan--------20.000------------30.000------------40.000
Piet--------15.000------------30.000-----------45.000
Klaas------35.000------------25.000-----------20.000

Dit moet getransformeerd worden in:

Naam----Jaar-----Inkomen
Jan------2006----20.000
Jan------2007----30.000
Jan------2008----40.000
Piet-----2006----15.000
Piet-----2007----30.000
Piet-----2008----45.000
Klaas----2006----35.000
Klaas----2007----25.000
Klaas----2008----20.000

Iemand een oplossing? Alvast 1000-maal dank!!!

 

[oeldere]

welkom op dit forum

met een voorbeeldbestandje, ontdaan van gevoelige info, wordt je vaak beter geholpen.

dit forum heeft ook een zoekfunctie.

een soortgelijke vraag is onlangs nog voorbijgekomen.

 

[Grootlicht]

Beste Oeldere, dank voor je suggestie, maar een zoekpoging op het forum had niet het gewenste resultaat opgelverd, waarna ik deze topic geopend heb. Mocht ik eenzelfde topic over het hoofd hebben gezien, kun je dan aangeven om welke topic het gaat?

Op verzoek hierbij een voorbeeldbestandje van wat er moet gebeuren...

Bekijk bijlage test.xlsx

 

[HSV]

Dan moet dit er op lijken.

Sub tst()
  Dim rij As Integer, kol As Integer, belasting As Integer, sq As Variant
   Sheets("Blad2").UsedRange.ClearContents
    
    belasting = WorksheetFunction.Match("Belasting *", Sheets("Blad1").Rows(1), 0) - 1 'Zoek in welke kolom "Belasting" zich bevindt
     
 sq = "Naam" & "|" & "jaar" & "|" & "inkomen" & "|" & "belasting" & "|"
   Sheets("Blad2").Range("A1").Resize(, 4) = Split(sq, "|")


For kol = 2 To Sheets("Blad1").Cells(Rows.Count, 1).End(xlUp).Row
   With Sheets("Blad2")
      .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(belasting - 1) _
        = WorksheetFunction.Transpose(Sheets("Blad1").Range(Sheets("Blad1").Cells(kol, 1), Sheets("Blad1").Cells(kol, 1)))
      .Cells(.Rows.Count, 3).End(xlUp).Offset(1).Resize(belasting - 1) _
        = WorksheetFunction.Transpose(Sheets("Blad1").Range(Sheets("Blad1").Cells(kol, 2), Sheets("Blad1").Cells(kol, belasting)))
      .Cells(.Rows.Count, 4).End(xlUp).Offset(1).Resize(belasting - 1) _
        = WorksheetFunction.Transpose(Sheets("Blad1").Range(Sheets("Blad1").Cells(kol, belasting + 1), Sheets("Blad1") _
        .Cells(kol, Sheets("Blad1").Cells(kol, Sheets("Blad1").Columns.Count).End(xlToLeft).Column)))
     End With
   Next kol

For rij = 2 To Sheets("Blad1").Cells(Rows.Count, 1).End(xlUp).Row
For kol = 2 To belasting
  With Sheets("Blad2")
   .Cells(.Rows.Count, 2).End(xlUp).Offset(1) _
        = Right(Sheets("Blad1").Cells(1, kol), 4)
     End With
    Next kol
   Next rij
  MsgBox "Alles is gekopieërd naar Blad2.  ", , "Hallo Grootlicht  "
End Sub

 

[Warme bakkertje]

@ Harry
Misschien een tip, ik zou voor de jaartallen eerst de array in het werkgeheugen volledig opbouwen en dan in 1 schrijfbewerking naar het werkblad wegschrijven.

For j = 1 To Sheets("Blad1").Cells(Rows.Count, 2).End(xlUp).Row - 1
        For i = 2 To 13
            sn = sn & Right(Sheets("Blad1").Cells(1, i), 4) & "|"
        Next i
    Next j
    Sheets("Blad2").Cells(Rows.Count, 2).End(xlUp).Offset(1). _
    Resize(UBound(Split(sn, "|"))) = WorksheetFunction.Transpose(Split(sn, "|"))

 

[HSV]

Oké @Rudi,

Net weer wakker.
Ik begrijp je hele verhaal (denk ik), en bijna de gehele code.

Je maakt er eerst een string van met "|" als scheidingsteken.
Dan haal je het weer uit elkaar en plaatst het onder elkaar.

Wat doet UBound.
Ik heb er al een aantal keren in de Help naar gezocht, maar ik kom niet verder dan lezen, begrijpen doe ik het niet (matrix?, maar wat is daar matrix aan?).

 

[Warme bakkertje]

Met UBound kijk je hoeveel elementen in een array zitten. Als je het aantal elementen op voorhand kent gebruik je bv. 1 to 10 Weet je dit echter niet dan heb je met UBound steeds het juiste aantal aanwezige elementen in een array.
I.c.m Resize kan je dus een bereik uitbreiden tot de grootte v/d array.
Dus eigenlijk zeg je
1. splits de array uit in afzonderlijke deeltjes == >Split(sn,"|")
2. tel het aantal uitgesplitste deeltjes ==> UBound(Split(sn,"|"))
3. Breid het bereik uit tot de grootte v/d array ==> Resize(UBound(Split(sn,"|")))

Hopelijk heb je hier iets aan.

 

[HSV]

@Rudi,

Natuurlijk heb ik daar iets aan.
Duidelijk en helder. :thumb:
Bedankt voor je hulp.