IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Tri un peu particulier [XL-2007]


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre éclairé
    Homme Profil pro
    Inscrit en
    Décembre 2011
    Messages
    343
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations forums :
    Inscription : Décembre 2011
    Messages : 343
    Par défaut Tri un peu particulier
    Bonjour,

    J'aimerai faire un trie aléatoire un peut particulier, en deux fasses
    J'ai les N° équipes et les noms dans l'onglet "Données" "A4:B200"

    J'aimerai que les N° équipes et les noms se rangent dans l'onglet "Tabl" dans les colonnes des 4 parties " C4200, H4:I200, M4:N200, R4S:200" dans un ordre aléatoire.

    Puis que les points dans l'onglet "Données " en colonne "C,D,E,F" se range en fonction du N° équipes et du nom et de la partie.

    Le tous si possible en VBA§

    Merci d'avance de votre aide

    Je joint mon fichier

    Cordialement

    Max
    Fichiers attachés Fichiers attachés

  2. #2
    Membre Expert
    Homme Profil pro
    Chef de projet en SSII
    Inscrit en
    Novembre 2011
    Messages
    1 503
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Irlande

    Informations professionnelles :
    Activité : Chef de projet en SSII

    Informations forums :
    Inscription : Novembre 2011
    Messages : 1 503
    Par défaut
    Je te propose le code suivant pour la première partie :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    Sub aleatoire()
    Dim rdm As Integer
    Dim upperbound As Integer
    Dim lowerbound As Integer
    Dim mem(1 To 200) As Integer
    Dim tst As Boolean
     
    upperbound = 200
    lowerbound = 1
     
    For i = 0 To 3
        j = 0
     
        For rest = 1 To 200
            mem(rest) = rest
        Next rest
     
        Do While j <= 199
            tst = False
            rdm = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
            For k = 1 To 200
                If mem(k) = rdm Then
                    mem(k) = 0
                    tst = True
                End If
            Next k
     
            If tst Then
                For rw = 0 To 1
                    Worksheets("Tabl").Range("C4").Offset(j, (i * 5) + rw) = Worksheets("Données").Range("A3").Offset(rdm, rw)
                Next rw
                    j = j + 1
            End If
     
        Loop
     
    Next i
     
     
    End Sub
    Dis moi s'il te convient !
    Il fonctionne pour 200 noms.

    Et ça c'est le code de ta deuxième partie :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    Sub recupscore()
    Dim mve As Range
     
    With Worksheets("Tabl")
        For j = 0 To 3
            For i = 0 To 199
                Set mve = .Range("D4").Offset(i, (j * 5))
                Worksheets("Données").Columns(2).Find(mve.Value, LookIn:=xlFormulas, lookat:=xlWhole).Offset(0, j + 1) = mve.Offset(0, 1)
            Next i
        Next j
    End With
     
    End Sub
    Si tu veux que les deux macros s'executent l'une à la suite de l'autre, tu as juste à rajouter "recupscore" avant le "End Sub" de la première macro !

    Tiens moi au courant !

  3. #3
    Membre éclairé
    Homme Profil pro
    Inscrit en
    Décembre 2011
    Messages
    343
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations forums :
    Inscription : Décembre 2011
    Messages : 343
    Par défaut
    Bonjour Kimy_Ire

    Et merci d'avoir pris du temps pour me répondre.

    Alors j'ai suivi les consignes, lorsque tu agir sur le code "Aléatoire" sa se range dans tous les sens c'est à dire que tu as des cellules vide et lorsque je fait recupscore je ne rentre pas les scores mais par contre sa efface les scores de la feuille données.
    Peut être que c'est moi qui me suis tromper j'ai mis le fichier avec les codes donne lui un coup d’œil SVP;

    Merci @+

    Max
    Fichiers attachés Fichiers attachés

  4. #4
    Expert éminent Avatar de mercatog
    Homme Profil pro
    Inscrit en
    Juillet 2008
    Messages
    9 435
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : Juillet 2008
    Messages : 9 435
    Par défaut
    Une autre proposition
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    Option Explicit
     
    Sub Traitement()
    Dim n As Long
    Dim m As Byte
    Dim Tb, Tmp
     
    Application.ScreenUpdating = False
    Initialisation Tb
    n = UBound(Tb, 1)
    For m = 1 To 4
        Aleatoire Tb
        Tmp = Resultat(Tb, m)
        Worksheets("Tabl").Cells(4, 5 * m - 2).Resize(n, 3) = Tmp
    Next m
    End Sub
     
    Private Sub Initialisation(ByRef Tb)
    Dim LastLig As Long
     
    Application.ScreenUpdating = False
    With Worksheets("Données")
        LastLig = .Cells(.Rows.Count, 2).End(xlUp).Row
        Tb = .Range("A4:F" & LastLig)
    End With
    End Sub
     
    Private Sub Aleatoire(ByRef Tb)
    Dim n As Long, i As Long, j As Long
    Dim m As Byte, p As Byte
    Dim Temp
     
    n = UBound(Tb, 1)
    p = UBound(Tb, 2)
    For i = 1 To n
        Randomize
        j = CLng(((n - i) * Rnd) + i)
        If i <> j Then
            For m = 1 To p
                Temp = Tb(i, m)
                Tb(i, m) = Tb(j, m)
                Tb(j, m) = Temp
            Next m
        End If
    Next i
    End Sub
     
    'k=i: Partie i
    Private Function Resultat(ByVal Tb, ByVal k As Byte)
    Dim n As Long, i As Long
    Dim Res()
     
    n = UBound(Tb, 1)
    ReDim Res(1 To n, 1 To 3)
    For i = 1 To n
        Res(i, 1) = Tb(i, 1)
        Res(i, 2) = Tb(i, 2)
        Res(i, 3) = Tb(i, k + 2)
    Next i
    Resultat = Res
    End Function

  5. #5
    Membre éclairé
    Homme Profil pro
    Inscrit en
    Décembre 2011
    Messages
    343
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations forums :
    Inscription : Décembre 2011
    Messages : 343
    Par défaut
    Bonjour Mercator,

    Je te remercie beaucoup pour le code qui est Nickel. J'aimerais lui apporter une modification pour le finaliser si tu le permet.
    Je m'explique dans un concours de belote il y a des personnes handicapées qui ont du mal a se déplacer, c'est pour cela que ses personnes doivent rester à leurs table pour les quatre parties.
    J'ai ajouter un code dans la feuille "Données" pour sélectionner "en rouge" des joueurs qui devrons rester a la même table.
    Et j'aimerai que les joueurs sélectionner prennent toujours les tables "1, 2, 3 ect..."pour toutes les quatre parties.

    Je joint mon fichier qui seras certainement plus explicatif.

    Merci d'avance et bonne journée

    Max
    Fichiers attachés Fichiers attachés

  6. #6
    Expert éminent Avatar de mercatog
    Homme Profil pro
    Inscrit en
    Juillet 2008
    Messages
    9 435
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : Juillet 2008
    Messages : 9 435
    Par défaut
    Il faudra ajouter une colonne dans la feuille Données (de préférence avant la colonne C) à cocher pour fixer les tables des joueurs correspondants

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Tri un peu particulier
    Par bucheron007 dans le forum Langage SQL
    Réponses: 2
    Dernier message: 19/01/2009, 14h09
  2. [MySQL] Question un tri un peu particulier
    Par infiniti dans le forum PHP & Base de données
    Réponses: 5
    Dernier message: 11/10/2008, 16h51
  3. Un tri un peu particulier
    Par GregPeck dans le forum Requêtes
    Réponses: 3
    Dernier message: 08/06/2006, 15h32
  4. #define un peu particulier
    Par greuh dans le forum C
    Réponses: 14
    Dernier message: 12/10/2005, 16h42
  5. Réponses: 2
    Dernier message: 05/01/2004, 11h23

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo