Gegevens anders ordenen

[Aqiel]

Hallo allemaal,

Ik heb het volgende probleem. Nu staan de gegevens zo geordend:

1000 2000 3000 etc.
7000 20 20 10
8000 10 20 20
9000 20 10 10
9100 5 20 20
etc.

Ik zou ze graag zo geordend willen hebben:

7000 1000 20
7000 2000 20
7000 3000 10
8000 1000 10
8000 2000 20
8000 3000 20
9000 1000 20
9000 2000 10
9000 3000 10
9100 1000 5
9100 2000 20
9100 3000 20
etc.

Het gaat om nog al veel gegevens. Kan iemand mij helpen?

Groeten,
Aqiel

[OctaFish]

En wat is de logica van je gegevens? Ik zie zo snel geen verband...

[Aqiel]

voorbeeld.xlsx

Ik heb de gegevens even in Excel gezet, dat is misschien duidelijker.

[popipipo]

Dat zal lastig worden.

Maar kun je uitleggen waarom je het in deze layout wilt hebben.
Als je namelijk een zoek functie wilt met een combinatie tussen GB en KP dan kun je het in de originel layout houden.

Zie voorbeeld

[Aqiel]

Het gaat om Grootboekrekeningen, kostenplaatsen en bedragen. 7000, 8000 etc. zijn de grootboekrekeningen, 1000, 2000 etc zijn de kostenplaatsen en 20,10 etc zijn de bedragen. De eerste ordening komt van de controller. Dit is zijn opzet voor de begroting. Maar om de begroting te importeren in het boekhoudpakket moet het andres geordend worden.

[WHER]

Probeer deze UDF-aanpak eens:

[enijhuis]

Je ontkomt er inderdaad niet aan om macro's te gebruiken om de gegevens te transformeren.
@WHER: mooie oplossing maar wanneer je KP's toevoegt zul je de formules moeten aanpassen.

Zie mijn bijlage: Wanneer je op de knop drukt worden de gegevens in de gewenste layout getoond in tab 'output'.
Nieuwe GB's / KP's worden automatisch meegenomen; Deze kun je in tab 'Input' er dus gewoon overheen plakken.
Let er alleen wel op dat je de cellen met bereiknamen 'Start_GB' en 'Start_KP' niet verwijderd (cellen A4 en B3). Verplaatsen mag uiteraard wel.

Voor de geïnteresseerden hierbij de code:

Option Explicit

Private Const ERR_CUSTOM = 666
Private Const APP = "Delegate.nl"

Private mcolKP As Collection

'Transformeer de inputgegevens naar de gewenste indeling
Public Sub TransformeerData()
       
    Dim rCell As Range
    
    On Error GoTo ErrH
    
    'Vraag bevestiging
    If MsgBox("Zeker weten?", vbQuestion + vbYesNo, APP) = vbNo Then Exit Sub
    
    Application.ScreenUpdating = False
    
    'Initialisatie-acties
    InitializeKP
    ShOutput.Cells.ClearContents
    ShOutput.Range("A1:C1") = Array("GB", "KP", "Bedrag")
        
    'Bepaal start-cel
    Set rCell = GetNamedRange("Start_GB")
    
    'Loop door alle GB-waarden
    Do While Not IsEmpty(rCell) And IsNumeric(rCell)
        Call PrintData(rCell)
        Set rCell = rCell.Offset(rowoffset:=1)
    Loop
        
    'Toon getransformeerde data
    ShOutput.Activate
    
    MsgBox "Klaar!", vbInformation, APP
    
CleanUp:
    Set mcolKP = Nothing
    Application.ScreenUpdating = True
    Exit Sub
ErrH:
    'Foutafhandeling
    Application.ScreenUpdating = True
    
    Select Case Err.Number
    
        Case ERR_CUSTOM
            MsgBox Err.Description, vbInformation, APP
        Case Else
            MsgBox "Onverwachte fout:" & vbCr & Err.Description, vbExclamation
    End Select
    
    Resume CleanUp
    
End Sub

'Schrijf de gegevens weg in tab output
Private Sub PrintData(rCellSource As Range)

    Dim rCellTarget As Range
    Dim i As Integer
    
    'Bepaal start-cel
    Set rCellTarget = ShOutput.Cells(Rows.Count, 1).End(xlUp)
    
    'Print per KP-waarde
    For i = 1 To mcolKP.Count
        
        Set rCellTarget = rCellTarget.Offset(rowoffset:=1)
        
        With rCellTarget
            .Offset(ColumnOffset:=0) = rCellSource
            .Offset(ColumnOffset:=1) = mcolKP(i)
            .Offset(ColumnOffset:=2) = rCellSource.Offset(ColumnOffset:=i)
        End With
        
    Next
    
End Sub

'Retourneer een collectie-object met KP's
Private Sub InitializeKP()

    Dim rCell As Range
    
    Set mcolKP = New Collection
    
    'Bepaal start-cel
    Set rCell = GetNamedRange("Start_KP")
    
    'Loop door alle KP-waarden
    Do While Not IsEmpty(rCell) And IsNumeric(rCell)
        mcolKP.Add rCell.Value
        Set rCell = rCell.Offset(ColumnOffset:=1)
    Loop

End Sub

'Retourneer een bereik o.b.v. de bereiknaam
Private Function GetNamedRange(sName As String) As Range

    Dim bFound As Boolean
    Dim nName As Name
    
    For Each nName In ThisWorkbook.Names
    
        If nName.Name = sName Then
            bFound = True
            Exit For
        End If
    Next
    
    If bFound Then
        Set GetNamedRange = ThisWorkbook.Names(sName).RefersToRange
    Else
        Err.Raise ERR_CUSTOM, , "De bereiknaam " & sName & " is niet aangetroffen!"
    End If

End Function

[WHER]

wanneer je KP's toevoegt zul je de formules moeten aanpassen

Inderdaad, maar deze beperking kunnen we omzeilen door in de formule het bereik "$B$4:$E$7" te vervangen door een genaamd dynamisch bereik, dat zich automatisch aanpast aan het aantal KP's en GB's.

[Piet Bom]

Met de INDEX-formule en nog wat hulpformules kan het ook zonder VBA

[Aqiel]

Allemaal super bedankt.
Ik zal het een en ander testen en laten weten waar ik voor gekozen heb.

[enijhuis]

Ik ben benieuwd!
Als je gaat testen let er dan op dat je met gegevens test die qua grootte overeenkomen met de realiteit

[sylvester-ponte]

deze zet de formules in het blad met een macro:

Sub FormulesMaken()
    Dim Tabel As Range: Set Tabel = Range([G1])  '("Blad1!B4:D7")
    Dim Naar As Range: Set Naar = Range([G2])(1, 3)
    Dim Rij, Kolom: Rij = Tabel(0, 1).Row: Kolom = Tabel(1, 0).Column
    Dim Temp As Range, Van As Range
    For Each Temp In Tabel
        Set Van = Temp
        Naar.FormulaR1C1 = "=" & Van.Parent.Name & "!R[" & Van.Row - Naar.Row & "]C[" & Van.Column - Naar.Column & "]"
        Set Van = Temp.Parent.Cells(Rij, Temp.Column)
        Set Naar = Naar(1, 0)
        Naar.FormulaR1C1 = "=" & Van.Parent.Name & "!R[" & Van.Row - Naar.Row & "]C[" & Van.Column - Naar.Column & "]"
        Set Van = Temp.Parent.Cells(Temp.Row, Kolom)
        Set Naar = Naar(1, 0)
        Naar.FormulaR1C1 = "=" & Van.Parent.Name & "!R[" & Van.Row - Naar.Row & "]C[" & Van.Column - Naar.Column & "]"
        Set Naar = Naar(2, 3)
    Next
    Naar.Parent.Select
    Naar.Select
End Sub

formulesPlaatsen met macro.xlsm
groet sylvester

[Aqiel]

@Sylvester en Enijhuis
Kunnen jullie je formule aanpassen dat wanneer een GB-KP combinatie geen bedrag heeft deze ook niet in de uitkomst tevoorschijn komt?

Als bijlage een iets groter voorbeeld met het orginele tabblad van KD1000. Er zijn meerdere KD, maar dat terzijde. Volgens mij moet ik wel simpel kopiëren -> plakken -> bewerken voordat ik überhaupt een formule kan toepassen om de gegevens anders te ordenen. Dus ik kopieer de gegevens van tabblad KD1000 naar een nieuw tabblad en ga daarmee aan de slag om ze anders te ordenen. Of jullie moeten een formule weten die vanuit het originele tabblad de gegevens verzameld en ordent in de gewenste volgorde.

De formule van WHER werkt tot nu toe het best omdat deze formule de combinaties zonder bedragen weg laat. Maar daarentegen is deze formule wel een aanslag op mijn pc omdat de formule elke keer gaat (her-)rekenen. En je kan je voorstellen dat wanneer ik dit voor 10 KD moet doen er geen houden meer aan is.

Ik hoor graag wat jullie gedachten zijn.

[enijhuis]

Hoi Aquil,

Dat is ook precies de reden dat ik je aanraadde realistische testgegevens te gebruiken. UDF's zijn geweldig maar vormen al snel een aanslag op je CPU.
Vragen:
-Staan alle KD-tabs (bijv. tab KD1000) in 1 Excel-bestand?
-Dient er per KD-tab geïmporteerd te worden in boekhoudpakket of kan het in 1 keer?

[WHER]

Je kan de "Application.Volatile" uit regel drie van de code weglaten en kijken of dat helpt.
Indien het een "éénmaal-per-dag" operatie is, kan je de resultaten (gele gebied) via copy/pastespecial als waarden plakken, dan is hij direct uit-gerekend.

[sylvester-ponte]

deze werkt meteen knop: Begroting methode Syl(1.zip
groet sylvester

[enijhuis]

Hoi Aqiel,
Uiteindelijk bleken je wensen toch een stuk gecompliceerder dan je in je eerste vraag aangaf.

Bijgaand bestand zou alle problemen moeten oplossen.

Aannames:
-Alle KD-tabs (bijv. tab KD1000) staan in 1 Excel-bestand
-Meerdere KD-tabs kunnen tegelijkertijd geïmporteerd worden in het boekhoudpakket

Eisen mbt de verwerking:
- Alleen tabs met een naam die 'KD' bevatten worden verwerkt (bijv 'KD1000')
- Per tab dienen de volgende cellen aanwezig te zijn:

1. Een cel met de tekst 'GB'
2. Een cel met de tekst 'KP'

(Let er op dat de cel alleen die waarde bevat)

- De labelteksten 'GB' en 'KP' dienen 1 regel boven de eerste bijbehorende waarde te staan
- Alleen aaneengesloten KP's worden verwerkt

Je kunt gewoon op de knop drukken en hoeft dus niet eerst allerlei gegevens te knippen/plakken.
Ik ben benieuwd naar je feedback.

[Aqiel]

Hoi Enijhuis en Sylvester,

Hij werkt super.

Mijn wensen waren inderdaad gecompliceerder dan in mijn eerste vraag. Maar als ik gelijk al mijn wensen kenbaar zou maken dan was het misschien een heel onduidelijk verhaal geweest. Ik wil iedereen nogmaals ontzettend bedanken. Ik ben heel wat wijzer geworden.

Ik durf het bijna niet te vragen

@ Enijhuis. Is er ook nog een mogelijkheid dat je in de Output achter de kolom KP een kolom van de tabbladen KD kan toevoegen? Dan heb ik alle output die ik nodig heb. Namelijk GB KP KD Bedrag. En ik zie dat de formule van Sylvester ook gelijk de GB-rekeningen sorteert van klein naar groot. Zou je dit ook nog kunnen aanpassen?

Groeten,
Aqiel

[enijhuis]

Wat bedoel je met:

Is er ook nog een mogelijkheid dat je in de Output achter de kolom KP een kolom van de tabbladen KD kan toevoegen?

Bedoel je daarmee de tabblad naam (bijv. KD1000), de KD-waarde (bijv. 1000) of iets anders?

[Aqiel]

Tranformeer Begroting v2 .xlsmDe KD-waarde zou fantastisch zijn. Dan zou de output er zo uit zien:

GB KP KD bedrag
80000 1000 1000 -13223000
81000 1000 1000 -207000
81050 1000 1000 -4567000
81090 1000 1000 -50000
85000 1930 1000 -12000
etc.