Tirage au sort avec pré tirage

  • Initiateur de la discussion Initiateur de la discussion gourdin
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

gourdin

XLDnaute Impliqué
Bonjour,

J'ai récupéré une macro qui me permet d'attribuer des N° à des noms (cf fichier joint) et qui fonctionne parfaitement (merci les forums).

L'affaire se complique car il arrive que des N° soit attribués à des noms avant le tirage au sort (têtes de série en sport).
Comment attribuer des numéros au sort en tenant compte de numéros déjà attribués ?

Voir pièce jointe

Merci
 

Pièces jointes

Avec le module de classe ListeAléat :
VB:
Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim C&, Plage As Range, LAt As New ListeAléat, T(), L&
If Target(1,1).Value <> "> TIRAGE" Then Exit Sub
C = Target.Column
Set Plage = Cells(8, C + 1).Resize(Cells(60000, C).End(xlUp).Row - 7, 2)
T = Plage.Value
Randomize
LAt.Init UBound(T, 1)
For L = 1 To UBound(T, 1)
   If Not IsEmpty(T(L, 2)) Then LAt.Remettre T(L, 1), L
   Next L
For L = 1 To UBound(T, 1)
   T(L, 1) = LAt.Aléat(L): Next L
Plage.Value = T
End Sub
 
Dernière édition:
Avec le module de classe ListeAléat :
VB:
Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim C&, Plage As Range, LAt As New ListeAléat, T(), L&
If Target(1,1).Value <> "> TIRAGE" Then Exit Sub
C = Target.Column
Set Plage = Cells(8, C + 1).Resize(Cells(60000, C).End(xlUp).Row - 7, 2)
T = Plage.Value
Randomize
LAt.Init UBound(T, 1)
For L = 1 To UBound(T, 1)
   If Not IsEmpty(T(L, 2)) Then LAt.Remettre T(L, 1), L
   Next L
For L = 1 To UBound(T, 1)
   T(L, 1) = LAt.Aléat(L): Next L
Plage.Value = T
End Sub
Celà fonctionne parfaitement merci
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
5
Affichages
1 K
Réponses
30
Affichages
3 K
  • Question Question
XL 2010 tournoi
Réponses
13
Affichages
3 K
Retour