Tri aléatoire

David · 13 Novembre 2008

Bonjour à tous

En cherchant sur le forum, j'ai trouvé cette macro de tri aléatoire, elle marche sur la colonne B, mais je voudrais que ça tri les colonnes B/C et D ensemble, je ne trouve pas ou lui dire choisir les 3 colonnes et faire un tri alétoire pour les 3 colonnes. Les données sur la même ligne doivent suivres le tri de la colonne B.

Code:

Sub Bouton1_QuandClic()
Dim tablo, temp
Dim i As Integer, j As Integer

With Sheets("Récapitulatif")
    tablo = .Range("B12:D" & .Range("B65536").End(xlUp).Row)
End With

ReDim Preserve tablo(1 To UBound(tablo), 1 To 2)

For i = 1 To UBound(tablo)
   tablo(i, 2) = Rnd
Next i

For i = 1 To UBound(tablo)
    
    For j = 1 To UBound(tablo)
        If tablo(i, 2) > tablo(j, 2) Then
            For k = 1 To 2
                temp = tablo(i, k)
                tablo(i, k) = tablo(j, k)
                tablo(j, k) = temp
            Next k
        End If
    Next j
Next i
       
For i = 1 To UBound(tablo)
    Cells(i + 11, 2) = tablo(i, 1)
Next i
End Sub

Merci d'avance

ROGER2327 · 28 Novembre 2008

Re : Tri aléatoire

Re-re-bonsoir DAVID

Voici le code répondant à votre demande :

Code:

Sub ARRANGER()
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 Me
        ta = .Range("B7: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
                    [COLOR="Red"]If tablo(i - 1, 2) <> tablo(i - 2, 2) Or tablo(j, 2) <> tablo(i - 1, 2) Then Exit For[/COLOR]
                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
        [COLOR="Red"]Loop While tablo(l, 2) = tablo(l - 1, 2) And tablo(l - 1, 2) = tablo(l - 2, 2)[/COLOR]
        .Range("B7:D" & .Range("B65536").End(xlUp).Row) = tablo
    End With
End Sub

La condition de fonctionnement devient :

Le triple de l'effectif du plus gros club est inférieur ou égal au double de l'effectif total augmenté de deux.

J'écrirai la procédure de contrôle de cette condition, mais pas ce soir : j'ai sommeil.

À suivre...

ROGER2327

ROGER2327 · 28 Novembre 2008

Re : Tri aléatoire

Bonsoir à tous

Je complète mon envoi d'hier avec une procédure de contrôle.

Code:

Sub ARRANGER()
    If listeClub() Then MsgBox "Mission impossible !": End
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 Me
        ta = .Range("B7: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 [COLOR="Green"]'Version "pas plus de deux fois de suite le même club"[/COLOR]
[COLOR="Green"]'                    If tablo(j, 2) <> tablo(i - 1, 2) Then Exit For 'Version "pas deux fois de suite le même club"[/COLOR]
                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) [COLOR="Green"]'Version "pas plus de deux fois de suite le même club"[/COLOR]
[COLOR="Green"]'        Loop While tablo(l, 2) = tablo(l - 1, 2) 'Version "pas deux fois de suite le même club"[/COLOR]
        .Range("B7:D" & .Range("B65536").End(xlUp).Row) = tablo
    End With
End Sub

Function listeClub()
Dim i As Long, j As Long
Dim ta, tc, tf As Boolean
    ta = Me.Range("C7:C" & Me.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 [COLOR="Green"]'Version "pas plus de deux fois de suite le même club"[/COLOR]
[COLOR="Green"]'        tf = tf Or 2 * tc(i, 2) - UBound(ta, 1) - 1 > 0 'Version "pas deux fois de suite le même club"[/COLOR]
    Next i
    listeClub = tf
End Function

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

Function listLin(tab2D) [COLOR="Green"]' ***
' Réduit un tableau à deux dimensions d'une seule ligne
' à la liste des valeurs distinctes de cette ligne.[/COLOR]
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) [COLOR="Green"]'***
' Transpose un tableau à deux dimensions.[/COLOR]
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

Pour ce qui est des commentaires, je n'ai pas eu le temps d'y pourvoir. Toutefois, le code étant assez simple et reprenant les techniques exposées dans mon envois du 17/11/2008 17h15, une lecture attentive devrait en permettre la compréhension. Si tel n'est pas le cas, reprenez contact.

ROGER2327

David · 1 Décembre 2008

Re : Tri aléatoire

Bonjour Roger2327, bonjour à tous

Merci pour tout le travail fournit, j'ai un petit problème quand je lance la macro ça me dit mauvaise utilisation du mot clé "Me"

Code:

Dim t As Long
    t = 2
    With Me
        ta = .Range("B7:D" & .Range("B65536").End(xlUp).Row)
        l = UBound(ta, 1): c = UBound(ta, 2) + 1

Sinon après une première compétition ce week end, nous avons eu quelques petits problèmes sur le tri aléatoire. En fait chaque club à sa propre musique et nous avons fait passé les nageuses 2 par 2 et il fallait du coup qu'elles soient du même club, donc il me faut un tri comme celui proposé par ROGER2327 et un autre ou il serait possible qu'une textbox s'ouvre et pose la question si l'on veut aléatoire (comme au dessus),2 ou 3 nageuses du même club pour le tri et bien sur quand se n'est plus possible de les mettre par 2 ou 3 que ça les mette à la suite.

Est ce possible ?

Merci d'avance pour toute l'aide apporté.

ROGER2327 · 1 Décembre 2008

Re : Tri aléatoire

Bonjour David

Le mot Me fait référence à la feuille dans laquelle est placé le code. Si le code est placé dans un module, il faut remplacer Me par Sheets("Nom_de_la_feuille_où_doit_opérer_le_code").

Pour le reste, je comprends de quoi il s'agit. Mais serait-il possible d'avoir la liste de toutes les conditions à remplir : on pourrait ainsi construire une solution sans perdre son temps à mettre au point des procédures qu'on abandonne le lendemain. (On peut obtenir à peu près tout ce qu'on veut, à condition de savoir ce qu'on veut ; souvent, le plus difficile n'est pas de résoudre un problème, mais de le bien poser.)

À bientôt,
ROGER2327

David · 1 Décembre 2008

Re : Tri aléatoire

Merci Roger2327

Pour le "Me" pas de problème et je te remercie, la procédure que tu viens de mettre au point n'est pas abandonnée, elle va me servir dans 2 autres feuilles de compétition, mais sur un 3ème feuille le classement est différent. (3 niveaux de compétition avec des règles différentes)

Ce soir, je te mets toutes les conditions à remplir, avec un fichier.

Je suis désolé, le classement est normalement aléatoire tel que tu viens de le faire, mais pour un compétition bien spécifique j'aurai besoin de ce nouveau type de tri. Il faut savoir que c'est une première, la FFN ayant changée les règles pour cette année, certaines choses pratiques ne sont découverte qu'une fois en compète. Ayant 72 nageuses, le temps manque pour qu'elles puissent passer une à une, il faut donc les passer 2 à 2 et comme chaque club a une musique différente, ça nous a pris un peu au dépourvu, j'ai donc fait un tri manuel mais qui n'était pas vraiment aléatoire, vu que j'ai trié par club et qu'ensuite j'ai fait des copier coller 2 par 2 en passant d'un club à l'autre, ce qui a eu pour effet de classer les clubs par ordre alphabétique dans un premier temps et sur chaque ordre de départ le club ayant la lettre A à donc commencé la compet à chaque fois.

J'ai une autre compète dans 2 semaines, j'aimerai bien être au top, grace à se tri.

Dans tous les les cas je te remercie de ta patience.

David · 2 Décembre 2008

Re : Tri aléatoire

Bonsoir à tous

Voila donc un fichier avec des explications, j'espere que cela est possible.

Merci d'avance

David · 4 Décembre 2008

Re : Tri aléatoire

Un petit up pour mon tri 🙂

Personne pour m'aider ?

Merci

David · 8 Décembre 2008

Re : Tri aléatoire

Encore un petit up.

J'ai besoin du mode de tri pour très bientôt.

Roger2327 n'est plus dans le coin ? Personne ne peut m'aider ?

Un petit renseignement sur le "Me", quand je change le premier Me par Sheets("Nom_de_la_feuille_où_doit_opérer_le_code"), ça marche, mais pour les Me suivant, j'ai essayé pas mal de chose et ça bloque toujours.

Code:

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

Merci d'avance

ROGER2327 · 9 Décembre 2008

Re : Tri aléatoire

Bonsoir DAVID

Tout vient à qui sait attendre disait... ...je ne sais plus qui, mais quelqu'un à bien dû le dire un jour.

Il se trouve que pour survivre, on doit quelquefois travailler... ...et même travailler de plus en plus pour gagner de moins en moins. Bref, je ne suis pas rentier et je donne (avec plaisir) un coup de main quand j'en ai le temps, à des heures où les rentiers dorment.

Je joins le classeur complété d'une procédure permettant de grouper les candidats par paires d'un même club (si le nombre de candidats d'un même club est impair, il en reste évidemment un en fin de colonne). Je n'ai pas eu le temps de m'occuper de la dernière feuille (j'ai un peu de mal à comprendre les explications, mais j'y reviendrai... ...plus tard).

Pour ce qui est des "problèmes" avec le mot-clé me, je ne vois pas d'où ils viennent tant que le code dans lequel il figure reste dans la feuille à laquelle me s'applique. L'aide d'Excel©, qu'il faut toujours consulter en cas de problème, dit :

« (...) Lorsqu'une classe peut comporter plusieurs instances, le mot clé Me offre la possibilité de faire référence à l'instance de la classe dans laquelle le code est exécuté. (...) »

Une feuille particulière étant une instance de la classe Sheets, le mot me placé dans le code d'une feuille donnée désigne cette feuille, et rien d'autre. Donc, si le code contenant me est, par exemple, déplacé d'une feuille vers un module, il engendre une erreur.

Si vous continuez à avoir des problèmes avec cela, communiquez-moi exactement dans quelle situation (quelle procédure ? située où ?).

Voilà tout pour l'instant... À suivre dans les jours qui viennent, et bon courage à vous pour la suite !

Bonne nuit !
ROGER2327

David · 9 Décembre 2008

Re : Tri aléatoire

Un grand merci ROGER2327

C'est exactement ce qu'il me fallait !!! Vraiment c'est sympa d'avoir passé autant de temps dessus. Je n'étais pas particulièrement préssé, juste que comme j'étais sans nouvelle, je faisait des petits up.

Je sais que j'abuse un peu, à moins que je ne l'ai pas vu, il me fallait sur l'onglet ordre de passe un tri de la colonne ballet à la colonne technique un tri aléatoire avec l'impossibilité de retrouver les nageuses dans la même moitié de tableau. Si on fait 2 ateliers on coupe la feuille ordre de passage en deux et elles ne peuvent pas passer des 2 cotés en même temps. 😉

Vraiment merci merci, je ne sais que dire de plus tellement je trouve ça super sympa !!

Tri aléatoire

David

XLDnaute Occasionnel

ROGER2327

XLDnaute Barbatruc

ROGER2327

XLDnaute Barbatruc

David

XLDnaute Occasionnel

ROGER2327

XLDnaute Barbatruc

David

XLDnaute Occasionnel

David

XLDnaute Occasionnel

Pièces jointes

David

XLDnaute Occasionnel

David

XLDnaute Occasionnel

ROGER2327

XLDnaute Barbatruc

Pièces jointes

David

XLDnaute Occasionnel

Discussions similaires

Tri aléatoire

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Occasionnel

Pièces jointes

XLDnaute Occasionnel

XLDnaute Occasionnel

XLDnaute Barbatruc

Pièces jointes

XLDnaute Occasionnel

Discussions similaires

Privacy & Transparency

Privacy & Transparency