• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Excel 2010 / VBA: CustomOrder

Status
Niet open voor verdere reacties.
tijmen_4real

tijmen_4real

Gebruiker
Lid geworden
20 apr 2005
Berichten
338
Hoi,

Ik probeer de gegevens in een werkblad via automatisch te laten sorteren op een vastgelegde volgorde.
Deze volgorde staat in kolom A, die loopt tot A25. De tabel loopt tot F25. De gewenste volgorde is:

  • 4 - Besteld
  • 3 - Besluitvorming
  • 2 - Offerte
  • 1 - Aanvraag FUE
  • 0 - Opgestart
  • 5 - Afgerond

Nu heb ik al vele pagina's met code bekeken, en hier het één en ander van meegenomen tot de volgende code:

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A2:F25")) Is Nothing Then Exit Sub
Range("A2:F25").Sort _
Key1:=Range("A2"), _
CustomOrder:="4 - Besteld,3 - Besluitvorming,2 - Offerte,1 - Aanvraag FUE,0 - Opgestart", _
Header:=xlGuess, _
MatchCase:=False, Orientation:=xlTopToBottom
Range("A65536").End(xlUp).Offset(1, 0).Select
End Sub

Maar, bij het veranderen van een waarde uit de lijst, bijv. van "0 - Opgestart" naar "1 - Aanvraag FUE", gebeurt er niets.
Wat doe ik verkeerd? En, nog belangrijker, hoe los ik dit op?

Bij voorbaat dank en met vriendelijke groet,

Tijmen
 
Volgens mij moet je eerst een customlist aanmaken

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
  If Intersect(Target, Range("A2:F25")) Is Nothing Then Exit Sub
  With Application
    .AddCustomList Split("4 - Besteld, 3 - Besluitvorming,2 - Offerte, 1 - Aanvraag FUE, 0 - Opgestart, 5 - Afgerond", ",")
    Range("A2:F25").Sort [A2], , , , , , , , .CustomListCount + 1
    .DeleteCustomList .CustomListCount
  End With
End Sub
 
Volgens mij is er geen +1 in de customlistcount.

Code: 
for i = 1 to .CustomListCount  '+ 1
        msgbox join(.GetCustomListContents(i), vblf)
     next
 
Is inderdaad vreemd maar zonder de +1 wordt er op de verkeerde customlist gesorteerd. (de een na laatste)
 
Inderdaad vreemd.
De help is nu ook niet dat je zegt van ... dat begrijp je direct...(Geeft een op één gebaseerd geheel getal op dat de verschuiving aangeeft in de lijst met aangepaste sorteeropdrachten).

Nog wel even de spaties weghalen achter de komma's.
Code: 
.AddCustomList Split("4 - Besteld,3 - Besluitvorming,2 - Offerte,1 - Aanvraag FUE,0 - Opgestart,5 - Afgerond", ",")
 
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
  If Intersect(Target, Range("A2:F25")) Is Nothing Then Exit Sub
  With Application
    .AddCustomList Split("4 - Besteld, 3 - Besluitvorming,2 - Offerte, 1 - Aanvraag FUE, 0 - Opgestart, 5 - Afgerond", ",")
    Range("A2:F25").Sort [A2], , , , , , , , .CustomListCount + 1
    .DeleteCustomList .CustomListCount
  End With
End Sub

Werkt, maar laat Excel vastlopen.... :(
Is dat omdat hij blijft 'loopen'?

Code: 
for i = 1 to .CustomListCount  '+ 1
        msgbox join(.GetCustomListContents(i), vblf)
     next

Moet bovenstaande worden toegevoegd...? Zo ja, waar precies?
Allen hartelijk dank voor de reacties (hulp)! :D
 
Plaats het bestandje even met de code erin waarmee je het getest hebt.

De code van HSV uit #4 is alleen om aan te tonen dat er geen .CustomListCount +1 bestaat. Uit de vervolgreacties kan je opmaken dat dit toch nodig is om de sortering te laten werken.
 
VenA zei:
Plaats het bestandje even met de code erin waarmee je het getest hebt.

De code van HSV uit #4 is alleen om aan te tonen dat er geen .CustomListCount +1 bestaat. Uit de vervolgreacties kan je opmaken dat dit toch nodig is om de sortering te laten werken.
Klik om te vergroten...

Zie bijlage voor het bestand. De code staat nu als commentaar.
Bij voorbaat dank!
 

Bijlagen

  • bestellingen-projecten-afd-vast31072017.xlsm
    27,5 KB · Weergaven: 26
Probeer het zo eens.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A2:F25")) Is Nothing Then Exit Sub
  With Application
    .EnableEvents = False
    .AddCustomList Split("4 - Besteld,3 - Besluitvorming,2 - Offerte,1 - Aanvraag FUE,0 - Opgestart,5 - Afgerond", ",")
    Range("A2:F25").Sort [A2], , , , , , , , .CustomListCount + 1
    .DeleteCustomList .CustomListCount
    .EnableEvents = True
  End With
End Sub
 
VenA zei:
Probeer het zo eens.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A2:F25")) Is Nothing Then Exit Sub
  With Application
    .EnableEvents = False
    .AddCustomList Split("4 - Besteld,3 - Besluitvorming,2 - Offerte,1 - Aanvraag FUE,0 - Opgestart,5 - Afgerond", ",")
    Range("A2:F25").Sort [A2], , , , , , , , .CustomListCount + 1
    .DeleteCustomList .CustomListCount
    .EnableEvents = True
  End With
End Sub
Klik om te vergroten...

Code werkt, maar laat ook in dit geval Excel vastlopen (en afsluiten :()
 
Het quoten is niet nodig.

Knalt er bij mij op een gegeven moment ook uit in Xl-2010 en ik kan niet vinden waarom. In Xl-2007 werkt het zonder problemen.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan