[VBA Excel] een hele moeilijke sorteer routine

[Verwijderd]

hallo allemaal, voor mijn vereniging wilde ik de boel eens vereenvoudigen, en de startlijsten die wij gebruiken automatiseren, dat vereenvoudigen is nou niet bepaald eenvoudig. en ik kom er zelf echt niet meer uit.

het probleem;
in totaal zijn er zo'n 80 deelnemers welke niet allemaal tegelijk mogen varen, slechts 5 a 6 tegelijk is het maximaal haalbare.
de voorwaarde waarop wij selecteren om bv 6 deelnemers in een groep te plaatsen is de frequentie van de boot. als die namelijk te kort bij elkaar zitten volgen er storingen daarom kiezen we ze liefst zo 4 a 5 waarde's uit elkaar.
de start gaat één voor één, aangezien dat dit een behendigheids sport is de finish ook na elkaar
dus first in first out, als bv nr. 1 gefinisht is vertrekt nr 6 indien nr 2 finisht vertrekt nr 7 enz. enz.

nu probeerde ik dus een sorteer routine te maken die mijn lijst zo sorteert dat de frequenties niet te dicht op elkaar volgen. maar dat valt dus zwaar tegen.
probleem is ook nog dat er redelijk veel frewuenties dicht op elkaar zitten en zelfs een aantal dubbele
eenvoudig is t niet maar ik heb die lijst gesorteerd met de had (een uurtje zwoegen) dus het is mogelijk maar mijn routine bakt er niets van pas na een x of 25 dezelfde routine uitvoeren blijf ik uiteindelijk over met een paar waarde waar ie niks meer mee kan.

wie weet hier raad mee, of kan mij verder helpen

we gebruiken een lijst in excel (duh)
kol A bevat een volgnummer
kol B bevat de deelnemer naam
kol C bootnaam
kol D boot frequentie

ik heb inmiddels het volgende script, maar dit loopt niet echt helemaal lekker, en zeker aan het eind als er nog maar een paar mogelijkheden zijn heeft ie er echt moeite mee, en uiteindelijk blijven er een paar over die ie niet (meer) kan

het liefst zou ik ook nog een controle willen op A kolom zodat ie niet 2 maal dezelfde deelnemer (met een andere boot) in zijn bereik van 5 á 6 kan plaatsen.

code:

Sub maaklijst()
Dim a, i As Long, ii As Integer, x As Long, y As Integer, temp, counter
With Range("a1").CurrentRegion
    x = .Rows.Count
    a = .Value
    y = Int(.Rows.Count / 2)
End With
here:
Sort5 a, LBound(a, 1), UBound(a, 1), 4
With Range("a1")
    .Resize(UBound(a, 1), UBound(a, 2)).Value = a
    .Offset(, 5).Resize(UBound(a, 1)).FormulaR1C1 = _
    "=--and(abs(rc[-2]-r[1]c[-2])>=5,abs(rc[-2]-r[2]c[-2])>=5,abs(rc[-2]-r[3]c[-2])>=5,abs(rc[-2]-r[2]c[-2])>=5)"
End With
    Range("f1").Offset(UBound(a)).FormulaR1C1 = _
        "=countif(r1c:r[-1]c,0)"
If Not Range("f:f").Find(what:=0, LookIn:=xlValues) Is Nothing Then
    For i = LBound(a, 2) To UBound(a, 2)
        temp = a(1, i): a(1, i) = a(UBound(a, 1) - counter, i): a(UBound(a, 1) - counter, i) = temp
    Next
    counter = counter + 1
    If Range("f1").Offset(UBound(a, 1)) <= 2 Then Exit Sub
    If UBound(a, 1) - counter = 1 Then Exit Sub
    GoTo here
End If
End Sub

Private Sub Sort5(ary, LB, UB, ref, Optional counter As Integer = 1)
Dim i As Long, ii As Integer, flag As Boolean, x, temp, n
Dim iii As Integer, iv As Long
ReDim Preserve ary(1 To UBound(ary, 1), 1 To ref + 1)
flag = True
For i = LBound(ary, 1) To UBound(ary, 1)
    For ii = 1 To 5
        If i + ii >= UB Then Exit For
        x = Abs(Val(ary(i, ref)) - Val(ary(i + ii, ref)))
        If x <= 5 Then
            n = i + ii
            For iv = UBound(ary, 1) To n + 1 Step -1
                If ary(iv, ref + 1) <> "N/A" Then
                    For iii = LBound(ary, 2) To UBound(ary, 2)
                        temp = ary(n, iii): ary(n, iii) = ary(iv, iii)
                        ary(iv, iii) = temp
                    Next
                    ary(iv, ref + 1) = "N/A": flag = False
                End If
            Next
        End If
    Next
Next
ReDim Preserve ary(1 To UBound(ary, 1), 1 To ref)
If flag = False Then
    counter = counter + 1
    If counter = 80 Then Exit Sub
    Sort5 ary, LB, UB, ref, counter
End If
End Sub

[ Voor 11% gewijzigd door Verwijderd op 26-08-2005 17:11 . Reden: tips ]

[Lustucru]

Zet even je code tussen [ code] [ /code] tags en spring in. Dat maakt het wat leesbaarder.

En misschien is het handig als je het even met een voorbeeld kunt verduidelijken.

Als ik het goed begrijp zoek je een optimaliseringsroutine die een lijst waarden kan opdelen in groepen van vijf a zes stuks waarbinnen de waarden zover mogelijk uit elkaar liggen. Kun je dan ook aangeven wat je routine precies doet en waar het dan uiteindelijk mis gaat?