Tirage au sort

[Jiheme]

Bonsoir le Forum,

J'ai adapté une macro de Pierrejean pour créer des duos entre les membres du personnel de la boite où je bosse.

Tout fonctionne, à l'exception des doublons, j'en ai presque toujours un ou deux. Comment puis je éviter cela ?

Merci

 

[Cousinhub]

Re : Tirage au sort

Bonsoir, Jiheme

une autre méthode (normalement pas de doublons....)

Sub tirag()
Dim Num As Integer, Nb1 As Integer, Nb2 As Integer
Dim Numero1 As Object, Numero2 As Object
Set Numero1 = CreateObject("Scripting.Dictionary")
Set Numero2 = CreateObject("Scripting.Dictionary")
Nb1 = 1
While Nb1 < 271
    Randomize (Timer)
    Num = Int((270) * Rnd + 1)
    If Not Numero1.Exists(Num) Then Numero1.Add Num, Num: Nb1 = Nb1 + 1
Wend
Nb2 = 1
While Nb2 < 271
    Randomize (Timer)
    Num = Int((270) * Rnd + 1)
    If Not Numero2.Exists(Num) And Numero1.Item(Nb2) <> Num Then Numero2.Add Num, Num: Nb2 = Nb2 + 1
Wend
Range("A2").Resize(Numero1.Count, 1).Value = Application.Transpose(Numero1.items)
Range("F2").Resize(Numero2.Count, 1).Value = Application.Transpose(Numero2.items)
End Sub

 

[saverloo]

Re : Tirage au sort

Bonsoir, Jiheme

une autre méthode (normalement pas de doublons....)

Sub tirag()
Dim Num As Integer, Nb1 As Integer, Nb2 As Integer
Dim Numero1 As Object, Numero2 As Object
Set Numero1 = CreateObject("Scripting.Dictionary")
Set Numero2 = CreateObject("Scripting.Dictionary")
Nb1 = 1
While Nb1 < 271
    Randomize (Timer)
    Num = Int((270) * Rnd + 1)
    If Not Numero1.Exists(Num) Then Numero1.Add Num, Num: Nb1 = Nb1 + 1
Wend
Nb2 = 1
While Nb2 < 271
    Randomize (Timer)
    Num = Int((270) * Rnd + 1)
    If Not Numero2.Exists(Num) And Numero1.Item(Nb2) <> Num Then Numero2.Add Num, Num: Nb2 = Nb2 + 1
Wend
Range("A2").Resize(Numero1.Count, 1).Value = Application.Transpose(Numero1.items)
Range("F2").Resize(Numero2.Count, 1).Value = Application.Transpose(Numero2.items)
End Sub

bonjour,

tu peux faire simplement la fonction supprimer doublon dans excel2007 avant selectionner la colonne forcement.
maintenant tu peux aussi faire une macro, selectionner la colonne ensuite faire tri et ensuite supprimer doublon. de la tu arretes l'enregistrement de ta makro et tu affectes celle ci a un bouton ou image

 

[saverloo]

Re : Tirage au sort

bonjour,

tu peux faire simplement la fonction supprimer doublon dans excel2007 avant selectionner la colonne forcement.
maintenant tu peux aussi faire une macro, selectionner la colonne ensuite faire tri et ensuite supprimer doublon. de la tu arretes l'enregistrement de ta makro et tu affectes celle ci a un bouton ou image

si maintenant tu as plusieurs personnes avec le meme prenom ou nom tu pourrais mettre le nom et prénom dans une meme case afin de ne pas avoir de conflit
enfin je dis ceci en cas ou

 

[Jiheme]

Re : Tirage au sort

Bonsoir Bhbh, saverloo

J'ai encore des "doublons" en fait pas des doublons au sens propres, mais un duo est formé par deux fois la même personne. Par contre, ta macro est beaucoup plus rapide que la précédente.

Saverloo, le problème ne viens pas d'homonymie, en effet le tirage est fait sur un N° et je récupère le nom et le prénom avec RECHERCHEV.

 

[Cousinhub]

Re : Tirage au sort

Re-,

oui, vu 😱

essaie ainsi (pas de doublons au bout d'une vingtaine d'essais......)

Sub tirag()
Application.ScreenUpdating = False
Dim Num As Integer, Nb1 As Integer, Nb2 As Integer
Dim Numero1 As Object, Numero2 As Object
Set Numero1 = CreateObject("Scripting.Dictionary")
Set Numero2 = CreateObject("Scripting.Dictionary")
Nb1 = 1
While Nb1 < 271
    Randomize (Timer)
    Num = Int((270) * Rnd + 1)
    If Not Numero1.Exists(Num) Then Numero1.Add Num, Num: Nb1 = Nb1 + 1
Wend
Range("A2").Resize(Numero1.Count, 1).Value = Application.Transpose(Numero1.items)
Nb2 = 1
While Nb2 < 271
    Randomize (Timer)
    Num = Int((270) * Rnd + 1)
    If Not Numero2.Exists(Num) And Cells(Nb2 + 1, 1).Value <> Num Then Numero2.Add Num, Num: Nb2 = Nb2 + 1
Wend
Range("F2").Resize(Numero2.Count, 1).Value = Application.Transpose(Numero2.items)
End Sub

 

[Jiheme]

Re : Tirage au sort

Re à tous

C'est bon, plus de problème, je te remercie beaucoup.

Bonne soirée à tous

 

[JCGL]

Re : Tirage au sort

Bonjour à tous,
Salut Bh²,

C'est bon, plus de problème, je te remercie beaucoup.

Moi, je trouve que c'est peu dire...
Sans remettre en cause les "Collection" de mon (notre) ami PJ 🙂, le "Scripting.Dictionary"...
Pfiou... Que de la balle.

Loin de vous actuellement mais le coeur y est...

A++ ami PJ 🙂
A++ ami Bh² 🙂

A+ à tous

 

[Cousinhub]

Re : Tirage au sort

Bonsoir,

JC 🙂

Merci pour ton commentaire, mais je pense pouvoir améliorer encore ce code....

Un ou deux détails, et j'y suis (mais pas ce soir).....

Moi, je trouve que c'est peu dire...

Bah..........

Edit : Avec son code : 59 secondes et quelques
Avec le mien, en gros, 0.3 seconde

Bonne soirée

 

[Jiheme]

Re : Tirage au sort

Bonjour Bhbh, JCGL

Je reconnais volontiers que mon admiration n'était pas assez dytirambique, mais c'est très simple : je n'ai rien compris, le "Scripting.Dictionnary" est totalement inconnu pour moi. Il faut d'ailleurs que j'en cherche les explications, car je déteste utiliser quelque chose que je ne comprend pas.

Par contre au niveau rapidité là j'ai compris de suite !!! c'est l'exemple type pour montrer, s'il le fallait encore, que deux codes parvenant au même résultat (mis à part le problème "doublon") ne passent pas su tout par le même chemin.

Une chose est sûre c'est que c'est largement au dessus de mon niveau, surtout que depuis quelques temps, j'ai du lever le pied cause boulot.

Merci encore et désolé d'être incapable d'apprécier vos talents.

Bonne journée à tous