VBA code voor custom sorteren

[Killerman1991]

Ik wil graag dat excel het op mijn eigen volgorde sorteerd.

Ik heb nu de volgende code:

 ElseIf Sheets("Dates").Cells(5, 22) = 2 Then  'Frequency
        Range("A7:AN39").Select
        Selection.Sort Key1:=Range("E7"), Order1:=xlAscending, Orientation:=xlTopToBottom
    End If

Hierdoor worden de cellen op alfabetische volgorde gestorteerd.

Wat ik wil is dat hij een zelfgemaakte volgorde handteerd. Misschien is hiervoor een aparte tablad nodig waarin deze volgorde gemaakt wordt.

De volgorde die hij hanteren moet is de volgende:

S = 1
DO = 2
DA = 3
DN = 4
W = 5
F = 6
M = 7
T = 8
SA = 9
A = 10

Wanneer een cel leeg is moet dit 11 worden.

Alvast bedankt voor jullie hulp

 

[Niels28]

Probeersel
Je sorteer sleutel op sheet 2 in A1 t/m 11
Ga er wel vanuit dat er alleen de tekens in de cel staan die je opgeeft.

Option Base 1
Sub sorteren()
sq = Range("A1:E50")
ReDim sn(UBound(sq), UBound(sq, 2))
For i = 1 To 11
    For ii = 1 To UBound(sq)
        If sq(ii, 1) = Sheets(2).Cells(i, 1).Value Then
            j = j + 1
            For jj = 1 To UBound(sn, 2)
                sn(j, jj) = sq(ii, jj)
            Next
        End If
    Next
Next
Range("A1:E50") = sn
End Sub

Niels

 

[Niels28]

Of zonder extra tabblad

Option Base 1
Sub sorteren()
sq = Range("A1:E50")
ReDim sn(UBound(sq), UBound(sq, 2))
For i = 1 To 11
    For ii = 1 To UBound(sq)
        If sq(ii, 1) = WorksheetFunction.Choose(i, "S", "DO", "DA", "DN", "W", "F", "M", "T", "SA", "A", "") Then
            j = j + 1
            For jj = 1 To UBound(sn, 2)
                sn(j, jj) = sq(ii, jj)
            Next
        End If
    Next
Next
Range("A1:E50") = sn
End Sub

Niels

 

[Killerman1991]

Probeersel
Je sorteer sleutel op sheet 2 in A1 t/m 11
Ga er wel vanuit dat er alleen de tekens in de cel staan die je opgeeft.

Option Base 1
Sub sorteren()
sq = Range("A1:E50")
ReDim sn(UBound(sq), UBound(sq, 2))
For i = 1 To 11
    For ii = 1 To UBound(sq)
        If sq(ii, 1) = Sheets(2).Cells(i, 1).Value Then
            j = j + 1
            For jj = 1 To UBound(sn, 2)
                sn(j, jj) = sq(ii, jj)
            Next
        End If
    Next
Next
Range("A1:E50") = sn
End Sub

Niels

Ik krijg de code er niet goed in:

Het ziet er zo uit:

 If Sheets("Dates").Cells(5, 22) = 1 Then 'run/stop
        Range("A7:AM39").Select
        Selection.Sort Key1:=Range("F7"), Order1:=xlDescending, Orientation:=xlTopToBottom
    ElseIf Sheets("Dates").Cells(5, 22) = 2 Then  'Frequency
        Range("A7:AN39").Select
        Selection.Sort Key1:=Range("AN7"), Order1:=xlAscending, Orientation:=xlTopToBottom
    End If

De code voor Run/stop is eigenlijk niet van toepassing.

Maar heb geprobeerd de code erin te zetten maar dat lukt dus niet.

Deze code moet in de huidige sub en volgens mij is dit weer een nieuwe sub.

 

[Niels28]

en hoe moet ik weten waar die moet komen?

Zet mijn code in een module en roep hem aan waar je hem nodig hebt.

zie voorbeeld

 If Sheets("Dates").Cells(5, 22) = 1 Then 'run/stop
        Range("A7:AM39").Select
        Selection.Sort Key1:=Range("F7"), Order1:=xlDescending, Orientation:=xlTopToBottom
        [COLOR="#FF0000"]call sorteren[/COLOR]
    ElseIf Sheets("Dates").Cells(5, 22) = 2 Then  'Frequency
        Range("A7:AN39").Select
        Selection.Sort Key1:=Range("AN7"), Order1:=xlAscending, Orientation:=xlTopToBottom
        [COLOR="#FF0000"]call sorteren[/COLOR]
    End If

Niels

 

[Killerman1991]

Dat ga ik even proberen bedankt voor de moeite

 

[Killerman1991]

Het werkt hij structureerd nu netjes alles op volgorde, ik heb de cell range aangepast want die letters staan in cell E.

Het probleem is dat hij die structureerd maar de tekst die in de andere cellen staat moet mee veranderen.



Zoals op het plaatje te zien is.

 

[Niels28]

Dat doet hij al, leer de macro eens begrijpen en je kunt het zelf aanpassen.
knap dat je de cel range aan hebt gepast omdat de letters in E staan maar dat heeft niks met de cel range te maken. Zoek maar eens hoe een array werkt.

Er is je op het forum al vaker aangeven dat je een voorbeeld excelbestand moet plaatsen en geen plaatjes.
Je bent zeer onduidelijk in je omschrijvingen en het blijft maar gokken wat je bedoelt.

Niels

 

[Killerman1991]

Ik heb hem er eerst zo ingezet als jij hem had gemaakt, maar dan krijg ik in elke cell een S te staan. Dit bestand heb ik zelf niet geschreven en is vrij complex, ik probeer hem alleen beetje aan te passen. Schijnbaar werkt dit niet omdat het z'n complex bestand is.

Er zijn heel veel tabbladen verborgen. Als je in de programmacode kijkt dan maakt de module Create Sched Macros het schema aan. Dit schema maak je aan als in in het tabblad input op "Maak schema" klikt.

Ik krijg als ik op "maak schema" klik de volgende fout : Compileerfout: Er wordt een variabele of procedure verwacht, geen module.

Ik hoop dat het zo wel lukt met hulp, ik ben maar een leek zoals je waarschijnlijk al in de gaten had.

Ik begrijp maar een klein gedeelde van de codes die erin staan.

Ik heb net een aantal keren geprobeerd om het excle bestand erop te zetten, maar krijg de melding dat hij niet groter dan 100kb mag zijn. Ik heb voor paar maand terug ook bestanden erop gezet van 200kb en die zie ik ook nog staan.

Weet iemand hier een oplossing voor?

 

[Timshel]

-Kijk eens of je het bestand klein genoeg kan krijgen door het op te slaan als binair bestand (.xlsb)
-Maak een voorbeeldbestand met minder gegevens.

 

[pixcel]

Je kunt gebruik maken van een ingebouwde oplossing: custom lists.
Via de interface: File > Options > Advanced > knop Edit Custom Lists (helemaal naar beneden scrollen)
Via vba: zie de help voor Application.AddCustomList
Bij een Sort kun je gebruik maken van CustomOrder
Een custom list wordt op applicatie niveau gemaakt, en is dus eenmaal aangemaakt in alle workbooks beschikbaar.

 

[Niels28]

Een voorbeeldbestandje met 2 verschillende macro's zie blad1 en blad2

Bekijk bijlage SORTEREN.xlsm

Niels

 

[pixcel]

    With Blad2.ListObjects(1).Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("MijnTabel[Key]"), _
            CustomOrder:="S,DO,DA,DN,W,F,M,T,SA,A"
        .Apply
    End With

 

[Killerman1991]

Een voorbeeldbestandje met 2 verschillende macro's zie blad1 en blad2

Bekijk bijlage 236511

Niels

Hallo Niels,

Het is een tijd geleden en ik ben er even mee aan het stoeien geweest. Ik begrijp nu gedeeltelijk de code ook wat betreft range etc.

Het werk alleen nog niet helemaal naar behoren.

De code is u als volgt:

Sub Sorteren()
sq = Range("A7:M39")
ReDim sn(UBound(sq), UBound(sq, 2))
For i = 1 To 11
    For ii = 1 To UBound(sq)
        If sq(ii, 5) = WorksheetFunction.Choose(i, "E", "DO", "DA", "DN", "W", "TW", "M", "K", "HJ", "J", "") Then
            j = j + 1
            For jj = 1 To UBound(sn, 2)
                sn(j, jj) = sq(ii, jj)
            Next
        End If
    Next
Next
Range("A7:M39") = sn
End Sub

Hier is de functie niet gebruikt


Hier is de functie wel gebruikt



Ik denk dat hij het verschuift doordat er lege cellen ertussen zitten. Zoals te zien is in het eerste plaatje zijn de cellen C7 tot en met C39 leeg en G7 tot en met G39 zijn ook leeg

Ik hoop dat er hiervoor en oplossing is alvast bedankt.

 

[Killerman1991]

Heeft iemand enig idee hoe ik dit wel werkend krijg?

 

[Niels28]

je bent dit stukje boven je code vergeten

Option Base 1

Niels

 

[Killerman1991]

je bent dit stukje boven je code vergeten

Option Base 1

Niels

Nu werkt hij naar behoren super bedankt

 

[snb]

gebruik de VBA funktie 'Choose' ipv de Excel funktie 'Choose'.