Teksten naar kolommen op basis van waarde

[emoes]

Hallo,

Ik krijg maandelijks een lijst met ruim 1500 regels.
In de bijlage een voorbeeld.
Het Tabblad "basic" ontvang ik maandelijks
Graag zou ik dit automatisch laten omzetten naar een lijst waarbij ik makkelijk op kan sorteren. (zie Tab blad: Extended)

Is dit makkelijk te realiseren ipv. handmatig de koppen de kopiëren?
Ontzettend bedankt.

MVG, AlexBekijk bijlage Change layout.xlsx

 

[Timshel]

Met een macrootje.

Sub tsh()
    Dim Br
    Dim i As Long
    Dim sServ As String, sLoc As String
    
    Br = Sheets("Basic").Cells(1).CurrentRegion
    With CreateObject("Scripting.Dictionary")
        .Item(0) = Array("Service", "Location", "Product", "Price")
        For i = 2 To UBound(Br)
            If Br(i, 2) = "" Then
                If Br(i + 1, 2) = "" Then sServ = Br(i, 1) Else sLoc = Br(i, 1)
            Else
                .Item(.Count) = Array(sServ, sLoc, Br(i, 1), Br(i, 2) / 2)
            End If
        Next
        Sheets("Extended").Cells(1, 1).Resize(.Count, 4) = Application.Index(.Items, 0, 0)
    End With
End Sub

 

[sylvester-ponte]

hallo Tim, mooi gemaakt. :thumb:
waarom halveer je de prijzen ? vond je het te duur?
verander:

.Item(.Count) = Array(sServ, sLoc, Br(i, 1), Br(i, 2) / 2)

in

.Item(.Count) = Array(sServ, sLoc, Br(i, 1), Br(i, 2))

wil je me leren wat Application.Index doet?

 

[sylvester-ponte]

Tim,die vraag van die prijs halvering kan ik beter aan emoes vragen. sorry

 

[Timshel]

wil je me leren wat Application.Index doet?

De loop voegt iedere keer een eendimensionale array, zeg maar een record, toe aan de dictionary-container.
Met Application.Index(.Items, 0, 0) voeg je aan het eind de eendimensionale arrays samen tot een tweedimensionale array.
Voor verdere toelichting kun je kijken op de site van snb. Hier heb ik het ook geleerd.

 

[emoes]

Hallo Tim,

Super ik ben er heel blij mee, het doet precies wat ik wil bereiken.
De prijs halveren was niet de bedoeling, maar ik zag het ook in de code staan en heb deze er dus uitgehaald.
Mogelijk dat ik in het maken van het voorbeeld een foutje had gemaakt.

Nogmaals bedankt het werk helemaal zoals ik in gedachte had.

MVG, Alex

 

[Timshel]

We aim to please :thumb:
Wil je ten slotte nog de vraag op opgelost zetten?

 

[sylvester-ponte]

Tim, bedankt voor de verwijzing naar de site van snb.
snb, bedankt voor de site.