Tri aléatoire

David · 26 Avril 2009

Bonjour à tous

Je reviens pour uncode que roger2327 m'a fait, j'avoue ma complète ignorance quand à se code. j'ai eu beau essayer mais ça me dépasse 🙁.

https://www.excel-downloads.com/threads/tri-aleatoire.107306/

Bref j'ai un problème, jusqu'à présent j'utilisais le code simple(pièces jointes) de tri_bug_2 et ça marchait bien, mais comme on peut voir les explications de roger2327, le code à ses limites quand il y a trop de fois le même club et ça vient de m'arriver, du coup quand je fais tri aléatoire sa part en vacances !! 🙁

j'ai donc essayé d'utiliser le code plus complet proposé par roger2327 avec le fichier tri_bug, mais j'ai un message d'erreur "Référence incorrecte ou non qualifiée".

Si quelqu'un pouvait me donner un coup de main ça serait super, j'ai une compete cette aprem et j'ai donc fait un tri manuel, mais c'est pas top et je ne peux donc pas préter l'outil au autres clubs tant que ça ne marche pas correctement.

Merci à tous pour l'aide que vous pourrez m'apporter.

soenda · 26 Avril 2009

Re : Tri aléatoire

Bonjour le fil, David

Vois la PJ (si j'ai bien compris)

A plus

David · 26 Avril 2009

Re : Tri aléatoire

Merci pour les réponses.

Oui c'est un mélange mais avec un tri arrangé.

la tri aléatoire arrangé que roger2327 a fait marche pour qu'il ne puisse y avoir 2 fois de suis le même club et ça marche, sauf quand un club est trop représenté (voir fichier tri_bug_2).

Je cherche donc un tri qui puisse faire ce que fait la macro arranger dans tri_bug_2, mais au cas ou le club soit trop représenté, que ça fasse un mélange simple, comme le propose soenda ou voir la première proposition de roger2327.

ci joint un fichier avec un exemple qui marche parfaitement sauf si un club est trop représenté.

La seconde proposition de roger2327 est censé faire le nécéssaire, pour qu'en cas de problème ça mette mission impossible, à la pace je mettrai un melange simple, mais j'ai le message d'erreur. 🙁

Devant les .Range il y avait Me, je les enlève pour que ça passe dans un module, mais la syntaxe n'est pas bonne vu qu'on est pas dans un Wtih ça ne peut commencer par un . (dixit excel)

Formule d'origne :

Code:

ta = Me.Range("C7:C" & Me.Range("B65536").End(xlUp).Row)

Merci

David · 26 Avril 2009

Re : Tri aléatoire

Salut j'y suis presque

il me faudrait juste savoir quoi mettre à la place de :

Code:

Sub ARRANGER()
If listeClub() Then Tri_inscription
            GoTo Fin

Quand la function listeclub est ok ça lance bien Tri_inscription et ça va à Fin, mais quand ça ne marche pas ça va quand même à fin, alors que je voudrais que la macro continu.

Code:

Sub ARRANGER()
If listeClub() Then Tri_inscription
            GoTo Fin
Dim ta, tablo, temp
Dim i As Long, j As Long, k As Long, l As Long, c As Long
Dim t As Long
    t = 2
    With Sheets("Récapitulatif")
        ta = .Range("B12:D" & .Range("B65536").End(xlUp).Row)
        l = UBound(ta, 1): c = UBound(ta, 2) + 1
        ReDim Preserve ta(1 To l, 1 To c)
        Do
            tablo = ta
            For i = 1 To l
               tablo(i, c) = Rnd
            Next i
            For i = 1 To l
                For j = 1 To l
                    If tablo(i, c) > tablo(j, c) Then
                        For k = 1 To c
                            temp = tablo(i, k)
                            tablo(i, k) = tablo(j, k)
                            tablo(j, k) = temp
                        Next k
                    End If
                Next j
            Next i
            ReDim Preserve tablo(1 To l, 1 To c - 1)
            For i = 3 To l
                For j = i To l
 '                   If tablo(i - 1, 2) <> tablo(i - 2, 2) Or tablo(j, 2) <> tablo(i - 1, 2) Then Exit For 'Version "pas plus de deux fois de suite le même club"
                  If tablo(j, 2) <> tablo(i - 1, 2) Then Exit For 'Version "pas deux fois de suite le même club"
                Next j
                If j > l Then Exit For
                For k = 1 To c - 1
                    temp = tablo(i, k)
                    tablo(i, k) = tablo(j, k)
                    tablo(j, k) = temp
                Next k
            Next i
     '   Loop While tablo(l, 2) = tablo(l - 1, 2) And tablo(l - 1, 2) = tablo(l - 2, 2) 'Version "pas plus de deux fois de suite le même club"
      Loop While tablo(l, 2) = tablo(l - 1, 2) 'Version "pas deux fois de suite le même club"
        .Range("B12:D" & .Range("B65536").End(xlUp).Row) = tablo
    End With
Fin:
End Sub

Function listeClub()
Dim i As Long, j As Long
Dim ta, tc, tf As Boolean
    ta = Range("C7:C" & Range("B65536").End(xlUp).Row)
    tc = listCol(ta)
    ReDim Preserve tc(1 To UBound(tc, 1), 1 To 2)
    For i = 1 To UBound(tc, 1)
        For j = 1 To UBound(ta, 1)
            tc(i, 2) = tc(i, 2) - (ta(j, 1) = tc(i, 1))
        Next j
     '   tf = tf Or 3 * tc(i, 2) - 2 * UBound(ta, 1) - 2 > 0 'Version "pas plus de deux fois de suite le même club"
      tf = tf Or 2 * tc(i, 2) - UBound(ta, 1) - 1 > 0 'Version "pas deux fois de suite le même club"
    Next i
    listeClub = tf
End Function

Function listCol(tab2D) ' ***
' REQUIS : 'transpose(tab2D)', 'listLin(tab2D)'
' Réduit un tableau à deux dimensions d'une seule colonne
' à la liste des valeurs distinctes de cette colonne.
    listCol = transpose(listLin(tab2D:=transpose(tab2D:=tab2D)))
End Function

Function listLin(tab2D) ' ***
' Réduit un tableau à deux dimensions d'une seule ligne
' à la liste des valeurs distinctes de cette ligne.
Dim i As Long, n As Long, s
    n = 1
    For Each s In tab2D
        For i = 1 To n
            If s = tab2D(1, i) Then Exit For
        Next i
        If i > n Then n = n + 1: tab2D(1, n) = s
    Next s
    ReDim Preserve tab2D(1 To 1, 1 To n)
    listLin = tab2D
End Function

Function transpose(tab2D) '***
' Transpose un tableau à deux dimensions.
Dim i As Long, j As Long, li As Long, lt As Long, ci As Long, ct As Long, u
    li = LBound(tab2D, 1): lt = UBound(tab2D, 1): ci = LBound(tab2D, 2): ct = UBound(tab2D, 2)
    ReDim u(ci To ct, li To lt)
    For i = li To lt
        For j = ci To ct
            u(j, i) = tab2D(i, j)
        Next j
    Next i
    transpose = u
End Function
Sub Tri_inscription()
Dim tablo, temp
Dim i As Integer, j As Integer, k As Integer
    With Sheets("Récapitulatif")
        tablo = .Range("B12:D" & .Range("B65536").End(xlUp).Row)
        ReDim Preserve tablo(1 To UBound(tablo, 1), 1 To UBound(tablo, 2) + 1)
        For i = 1 To UBound(tablo, 1)
           tablo(i, UBound(tablo, 2)) = Rnd
        Next i
        For i = 1 To UBound(tablo, 1)
            For j = 1 To UBound(tablo, 1)
                If tablo(i, UBound(tablo, 2)) > tablo(j, UBound(tablo, 2)) Then
                    For k = 1 To UBound(tablo, 2)
                        temp = tablo(i, k)
                        tablo(i, k) = tablo(j, k)
                        tablo(j, k) = temp
                    Next k
                End If
            Next j
        Next i
        ReDim Preserve tablo(1 To UBound(tablo, 1), 1 To UBound(tablo, 2) - 1)
        .Range("B12:D" & .Range("B65536").End(xlUp).Row) = tablo
    End With

End Sub

Merci

David · 26 Avril 2009

Re : Tri aléatoire

C'est bon j'ai trouvé.

Merci à tous.

[edit]

J'ai utlisié

Code:

If listeClub() Then Tri_inscription: End

Bizarrement j'avais utilisé un End if comme tu le proposes Gyruss, mais j'ai du me planter ça disait End If sans bloc If et pourtant quand je fais un copier coller de ton End If ça marche !!

Merci pour ta soluce.

Tri aléatoire

David

XLDnaute Occasionnel

Pièces jointes

soenda

XLDnaute Accro

Pièces jointes

David

XLDnaute Occasionnel

Pièces jointes

David

XLDnaute Occasionnel

David

XLDnaute Occasionnel

Discussions similaires

Tri aléatoire

David

XLDnaute Occasionnel

Pièces jointes

soenda

XLDnaute Accro

Pièces jointes

David

XLDnaute Occasionnel

Pièces jointes

David

XLDnaute Occasionnel

David

XLDnaute Occasionnel

Discussions similaires

Privacy & Transparency

Privacy & Transparency