Excel tabel omzetten dmv loop in VBA?

Status
Niet open voor verdere reacties.

hankoning

Nieuwe gebruiker
Lid geworden
23 apr 2022
Berichten
1
Hallo,

Ik ben bezig om een tabel welke onhandig is opgezet om te bouwen naar andere vorm;

Het is nu als volgt:

NrOmschrijvingItem 1Item 2Item 3Item 4Item 5
1Voorbeeld tekst 15431
2Voorbeeld tekst 2442
3Voorbeeld tekst 353
4Voorbeeld tekst 43
5Voorbeeld tekst 554
6Voorbeeld tekst 63
7Voorbeeld tekst 7
8Voorbeeld tekst 855
9Voorbeeld tekst 9
10Voorbeeld tekst 10533
11Voorbeeld tekst 113
12Voorbeeld tekst 12343
13Voorbeeld tekst 13
14Voorbeeld tekst 1434
15Voorbeeld tekst 1524


En ik wil 'm ombouwen naar:

NrOmschrijvingItemWaarde
1Voorbeeld tekst 115
1Voorbeeld tekst 124
1Voorbeeld tekst 13
1Voorbeeld tekst 143
1Voorbeeld tekst 151
2Voorbeeld tekst 214
2Voorbeeld tekst 224
2Voorbeeld tekst 232
2Voorbeeld tekst 24
2Voorbeeld tekst 25
3Voorbeeld tekst 315
3Voorbeeld tekst 32
3Voorbeeld tekst 33
3Voorbeeld tekst 343
3Voorbeeld tekst 35
4Voorbeeld tekst 415
4Voorbeeld tekst 42
4Voorbeeld tekst 434
4Voorbeeld tekst 44
4Voorbeeld tekst 45


Dan kan ik daarna met draaitabellen en extra info per regel beter inzichtelijk maken wat status is dan hoe de tabel nu is opgebouwd in plaatje 1.

Het gaat om ca 500 regels die ik moet ombouwen met 20 kolommen naar rechts dus het voorbeeld is redelijk versimpeld. Het principe komt hiermee wel duidelijk naar voren.

Het idee van de loop is dus:

- pak op Blad1 de 1e regel tekst (los van titels), kopieer deze en plaats deze op de 1e vrij cel op Blad 2;
- kopieer deze waarde dan nog eens naar de volgende 4 regels
- plaats dan middels transponeer de namen van de kolommen 1-5
- plaats dan middels transponeer de waarden die achter deze velden horen te staan;
- ga dan terug naar blad1
- ga door naar nr 2 etc etc totdat tot en met nr 15 is omgezet naar de nieuwe tabel op blad 2
- opmaak is niet belangrijk.


Ik ben zelf ondertussen al aardig wat filmpjes en oefenen verder maar merk dat mijn kennis te ver is weggezakt. Voor de echte VBA-hero zou dit een dubbele loop met een paar transponeer trucjes zo gepiept moeten zijn. Toch? Of toch lastiger dan ik overzie?

Wie o wie kan helpen! Mijn dank is groot.
 

Bijlagen

  • voorbeeld.xlsx
    13,5 KB · Weergaven: 13
Laatst bewerkt:
Code:
Sub M_snb()
 sn = Sheet1.ListObjects(1).Range
 ReDim sp(UBound(sn) * (UBound(sn, 2) - 2), 3)
 
 For j = 2 To UBound(sn)
   For jj = 3 To UBound(sn, 2)
     If sn(j, jj) <> "" Then
        sp(n, 0) = sn(j, 1)
        sp(n, 1) = sn(j, 2)
        sp(n, 2) = sn(1, jj)
        sp(n, 3) = sn(j, jj)
        n = n + 1
     End If
   Next
  Next
  
  Sheet1.Cells(2, 10).Resize(UBound(sp), 4) = sp
End Sub
 
Andere optie: (met 3 klikken in Power Query)

Code:
let
    Bron = Excel.CurrentWorkbook(){[Name="Tabel1"]}[Content],
    ReplNull = Table.ReplaceValue(Bron,null,0,Replacer.ReplaceValue,{"Item 1", "Item 2", "Item 3", "Item 4", "Item 5"}),
    RepZer = Table.ReplaceValue(Table.UnpivotOtherColumns(ReplNull, {"Nr", "Omschrijving"}, "Kenmerk", "Waarde"),0,null,Replacer.ReplaceValue,{"Waarde"})
in
    RepZer
 

Bijlagen

  • voorbeeld (13).xlsx
    23,2 KB · Weergaven: 9
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan