Data kolommen omzetten naar rijen (vorm van transponeren)

[skystormer]

Goedemorgen mensen,

Ik zit met een bestand dat ik zo wil aanpassen zodat ik wekelijks gegevens met elkaar kan vergelijken. Op het moment gebruik ik een draaitabel. Echter het aantal gegevens maakt een draaitabel niet wenselijk en met verdere kijk dat ik hier diverse formules nog in wil maken.

Wekelijks krijg ik een bestand (een soort bestellijst).
Voor ons is het dus van belang dat de producten dus ook op tijd klaar ligt. Maar elke week kan deze bestellijst afwijken met de voorgaande.
Bijvoorbeeld iets wat men eerst wilde in Week 15 willen ze nu pas in Week 20 of misschien in Week 1. Zo kunnen de aantallen dus ook afwijken. (uit de gegevens die hieruit gevonden gaan worden kunnen wij weer vervolgacties ondernemen)
Nu wil ik die gegevens onder elkaar hebben. (dit ook omdat bijna al mijn andere bestellijsten ook alle gegevens onder elkaar zetten, en ik hiervan dus 1 totaalbestand kan maken en hierbij heb ik de gegevens in 1 formaat nodig)
Nu wil ik het dus mogelijk maken dat ik de gegevens uit pakweg 50 bestanden onder elkaar kan zetten in werkblad Forecasts.
En de gegevens in werkblad Resultaten netjes onder elkaar krijg.

Iemand een idee hoe ik deze vorm van transponeren kan toepassen? (zie bijlage)

Bij voorbaat dank voor alle hulp.

 

[snb]

Sub M_snb()
   sn = Sheet1.Cells(1).CurrentRegion
   
   With CreateObject("scripting.dictionary")
       For j = 2 To UBound(sn)
         For jj = 5 To UBound(sn, 2) - 1
            If sn(j, jj) <> "" Then .Item(.Count) = Array(sn(j, 1), sn(j, 2), sn(j, 3), sn(j, 4), sn(1, jj), sn(j, jj))
         Next
       Next

       Sheet2.Cells(20, 1).Resize(.Count, 6) = Application.Index(.items, 0, 0)
   End With
End Sub

 

[skystormer]

Hey SNB,
Dank je voor de code. (had niet verwacht dat VBA nodig zou zijn voor deze)

Ik heb je code in een module gezet.
En krijg een object vereist foutcodering (424) als ik deze dan vervolgens uitvoer mbv alt-F8.

sn = Sheet1.Cells(1).CurrentRegion

Dus krijg deze niet aan de gang. Helaas ben ik te visueel ingesteld. Dat ik graag zie hoe deze werkt. en van daaruit ga werken wat alles doet als ik iets aanpas.

 

[Cobbe]

Dit had je toch ook zelf kunnen achterhalen:

Sub M_snb()
   sn = Sheets(1).Cells(1).CurrentRegion
   
   With CreateObject("scripting.dictionary")
       For j = 2 To UBound(sn)
         For jj = 5 To UBound(sn, 2) - 1
            If sn(j, jj) <> "" Then .Item(.Count) = Array(sn(j, 1), sn(j, 2), sn(j, 3), sn(j, 4), sn(1, jj), sn(j, jj))
         Next
       Next

       Sheets(2).Cells(20, 1).Resize(.Count, 6) = Application.Index(.items, 0, 0)
   End With
End Sub

 

[skystormer]

Je laat em zien en ik ben door stomheid geslagen dat ik nu ongeveer een half uur aan het nadenken ben hoe ik deze kan goedpraten dat ik die niet zag.
Bijna opgelost, zit nog met de datumnotatie dat de Amerikaanse datumstructuur wordt toegepast. Ben deze nog aan het zoeken hoe en waar ik die moet plaatsen.
Array(sn(j, 1) = Format(dd / mm / yyyy) geprobeerd, maar zonder succes. Dus ben deze nog verder aan het zoeken ook.

 

[Cobbe]

Niet de beste aanpassing maar wel een die werkt:

Sub M_snb()
   sn = Sheets(1).Cells(1).CurrentRegion
   
   With CreateObject("scripting.dictionary")
       For j = 2 To UBound(sn)
         For jj = 5 To UBound(sn, 2) - 1
            If sn(j, jj) <> "" Then .Item(.Count) = Array(Format(sn(j, 1), "mm/dd/yyyy"), sn(j, 2), sn(j, 3), sn(j, 4), sn(1, jj), sn(j, jj))
         Next
       Next

       Sheets(2).Cells(20, 1).Resize(.Count, 6) = Application.Index(.items, 0, 0)
   End With
End Sub

 

[snb]

Als je een voorbeeldbestand hier plaatst moet je niet verbaasd zijn dat er code wordt voorgesteld die in dat voorbeeldbestand werkt.

Sub M_snb()
   sn = Sheet1.Cells(1).CurrentRegion
   
   With CreateObject("scripting.dictionary")
       For j = 2 To UBound(sn)
         For jj = 5 To UBound(sn, 2) - 1
            If sn(j, jj) <> "" Then .Item(.Count) = Array(CLng(sn(j, 1)), sn(j, 2), sn(j, 3), sn(j, 4), sn(1, jj), sn(j, jj))
         Next
       Next

       Sheet2.Cells(20, 1).Resize(.Count, 6) = Application.Index(.items, 0, 0)
   End With
End Sub

Of gebruik de ISO-notatie:

            If sn(j, jj) <> "" Then .Item(.Count) = Array(Format(sn(j, 1), "yyyy-mm-dd"), sn(j, 2), sn(j, 3), sn(j, 4), sn(1, jj), sn(j, jj))

 

[skystormer]

Zat gelukkig wel in de goede hoek te denken waar de aanpassing moest komen, want alle voorbeelden die ik via andere wegen vond keken puur om een celwaarde aan te passen. niet een celwaarde gelijk via een andere VBA code.

Dit is em helemaal.
Ik kan hier zeker verder mee.
En dank je.

Opgelost.