Repartition d'une liste de 800données, en 3 liste aléatoires

Le 05/08/2009 à 12:36

Bonjour,

j'ai parcouru pas mal de forums sans trouver de réponse que je puisse appliquer dans mon cas, étant assez nul en macros excel.

mon souci est le suivant : nous sommes 3 commerciaux et devons nous repartir une liste de 800 personnes environ à contacter. pour éviter les abus, un tirage au sort me parait la meilleure option, mais j'ignore comment mettre en place la fonction alea dans excel, et surtout comment eviter les doublons

je cherche une macro qui idéalement répartisse 800/3 personnes au hasard, sans doublon, et raffinement ultime, idéalement que ces trois listes soit recréées dans des onglets différents. cette dernière étape étant uniqument de la faignantise de ma part, si vous pouvez déja m'aider avec la fonction random et la copie des 3 listes obtenues sur la meme page, ca serait génial

merci à ceux et celles qui me liront

Le 05/08/2009 à 13:03

Bonjour,

Le moyen le plus simple, c'est de créer une deuxième colonne dans laquelle tu auras un nombre aléatoire et de trier ton tableau par cette nouvelle colonne.

1. en face du premier nom tu tapes la formule : =alea()

2. tu copies cette case à coté de tous tes noms (clic coin inferieur bas droite de la cellule et tu glisse jusqu'en bas)

3. tu tries suivant la colonne des nombres.

j'ai tester ya beaucoup de chiffres apres la virgules ^^

reste a voir comment tu veut partagé, les 267 premier sont pour mr A, les 266 pour mr B et 267 pour Toi par exemple

je regarde pour la copie, c'est assez simple normalement faut juste trouver le bon code ^^

Le 05/08/2009 à 13:15

Bonjour,

Merci de bien vouloir changer le titre de ton sujet et de mettre un sujet en rapport avec ta demande.

Pour t'aider --> https://www.excel-pratique.com/forum/viewtopic.php?t=13

Merci de ta compréhension pour le forum

Amicalement

Dan

Le 05/08/2009 à 13:15

Par contre attention !!

A chaque fois que la feuille est valider ( tu appuie sur entre quelque part, tu rajoute un mot ou un caractère dans une cellule , etc etc ^^ )

les chiffres vont changer !

donc, une fois le trie effectuer, sois tu supprime la colonne avec le =alea() sois tu copi la colonne des client dans une autre colonne

Le 05/08/2009 à 16:06

Bonjour et bienvenue,

j'ai parcouru pas mal de forums sans trouver de réponse

Il fallait venir ici en 1er !

dans quelle colonne est la liste des 800 noms ?

y-a-t-il une ligne d'en-tête ?

y-a-t-il quelque chose à coté (autres colonnes) ?

à suivre

Claude.

Le 05/08/2009 à 17:02
dubois a écrit :

Bonjour et bienvenue,

j'ai parcouru pas mal de forums sans trouver de réponse

Il fallait venir ici en 1er !

dans quelle colonne est la liste des 800 noms ?

y-a-t-il une ligne d'en-tête ?

y-a-t-il quelque chose à coté (autres colonnes) ?

à suivre

Claude.

Bonjour,

la liste des 800 noms est en colonne A, et j'ai effectivement d'autre colonnes (prenom en b, puis pays, ca etc)

Il y a une ligne d'en tete, mais je peux toujours la virer si necessaire avant de lancer une macro

Le 05/08/2009 à 18:15

re,

Sans modifier ta feuille

assure-toi d'avoir Feuil2, Feuil3 et Feuil4 vierges

Sub Listes()
Dim Lg As Integer
Lg = Range("A65536").End(xlUp).Row - 1
Application.CutCopyMode = False
    Range("b:b").Insert
    SerieSansDoublons Lg, Range("b2")
End Sub
Private Sub SerieSansDoublons(NbValeurs As Integer, Cell As Range)
    Dim Tableau() As Integer, TabNumLignes() As Integer
    Dim I As Integer, k As Integer, Lg As Integer
    ReDim Tableau(NbValeurs)
    ReDim TabNumLignes(NbValeurs)
    Application.ScreenUpdating = False
        For I = 1 To NbValeurs
            TabNumLignes(I) = I
            Tableau(I) = I
        Next
            Randomize
    For I = NbValeurs To 1 Step -1
        k = Int((I * Rnd) + 1)
        Cells(Cell.Row + I - 1, Cell.Column) = Tableau(TabNumLignes(k))
        TabNumLignes(k) = TabNumLignes(I)
    Next
        Range("A2:B268").Copy Destination:=Range("feuil2!a2")
        Range("A269:B535").Copy Destination:=Range("feuil3!a2")
        Range("A536:B900").Copy Destination:=Range("feuil4!a2")
        Range("b:b").Delete
            With Sheets("Feuil2")
            .Activate
            .Range("A1:B400").Sort Key1:=.Range("B1"), Order1:=xlAscending, _
            Header:=xlGuess, OrderCustom:=1, MatchCase:=False
            End With
        With Sheets("Feuil3")
        .Activate
        .Range("A1:B400").Sort Key1:=.Range("B1"), Order1:=xlAscending, _
        Header:=xlGuess, OrderCustom:=1, MatchCase:=False
        End With
            With Sheets("Feuil4")
            .Activate
            .Range("A1:B400").Sort Key1:=.Range("B1"), Order1:=xlAscending, _
            Header:=xlGuess, OrderCustom:=1, MatchCase:=False
            End With
End Sub

Amicalement

Claude.

Le 05/08/2009 à 21:39

re,

La même mais avec avec n'importe quelle quantité de noms, toujours 3 listes.

Tu lance la macro "Listes" (les 2 codes sont dans un module)

Sub Listes()
Dim Lg As Integer
Lg = Range("A65536").End(xlUp).Row - 1
Application.CutCopyMode = False
    Range("b:b").Insert
    SerieSansDoublons Lg, Range("b2")
End Sub
Private Sub SerieSansDoublons(NbValeurs As Integer, Cell As Range)
    Dim Tableau() As Integer, TabNumLignes() As Integer
    Dim I As Integer, k As Integer, Lg As Integer, Tiers As Integer
    ReDim Tableau(NbValeurs)
    ReDim TabNumLignes(NbValeurs)
    Application.ScreenUpdating = False

        For I = 1 To NbValeurs
            TabNumLignes(I) = I
            Tableau(I) = I
        Next
            Randomize
    For I = NbValeurs To 1 Step -1
        k = Int((I * Rnd) + 1)
        Cells(Cell.Row + I - 1, Cell.Column) = Tableau(TabNumLignes(k))
        TabNumLignes(k) = TabNumLignes(I)
    Next
            Lg = Range("A65536").End(xlUp).Row - 1
            Tiers = WorksheetFunction.Floor(Lg / 3, 1) 'Plancher
        Range("A2:B" & Tiers).Copy Destination:=Range("feuil2!a2")
        Range(Range("A" & Tiers + 1), Range("b" & 2 * Tiers)).Copy Destination:=Range("feuil3!a2")
        Range(Range("A" & 2 * Tiers + 1), Range("b" & Lg)).Copy Destination:=Range("feuil4!a2")
        Range("b:b").Delete
            With Sheets("Feuil2")
                .Activate
                .Range("A1:B" & Lg).Sort Key1:=.Range("B1"), Order1:=xlAscending, _
                Header:=xlGuess, OrderCustom:=1, MatchCase:=False
            End With
        With Sheets("Feuil3")
            .Activate
            .Range("A1:B" & Lg).Sort Key1:=.Range("B1"), Order1:=xlAscending, _
            Header:=xlGuess, OrderCustom:=1, MatchCase:=False
        End With
    With Sheets("Feuil4")
        .Activate
        .Range("A1:B" & Lg).Sort Key1:=.Range("B1"), Order1:=xlAscending, _
        Header:=xlGuess, OrderCustom:=1, MatchCase:=False
    End With
End Sub

Claude.

Le 06/08/2009 à 08:49

genial, merci pour votre aide, j'essaye vos solutions ce matin

Le 06/08/2009 à 10:09

Bonjour à tous,

Avec création des feuilles,

https://www.excel-pratique.com/~files/doc2/TableauAlea_Claude3.xls

Amicalement

Claude.

Le 06/08/2009 à 11:25

re,

Erreur de raisonnement dans le fichier précédent,

Prendre celui-ci

https://www.excel-pratique.com/~files/doc2/TableauAlea_Claude4.xls

Claude

Rechercher des sujets similaires à "repartition liste 800donnees aleatoires"