tirage aléatoire

[Crespo]

Bonjour,

Je souhaiterais effectuer un tirage sans double avec des critères.

Ci-joint le fichier avec un exemple.

La colonne A peut être "flexible" avec moins ou plus d'éléments

Merci pour votre aide

 

[Crespo]

Vous ne nous donnez pas la logique du remplissage.

Pourquoi B129 en I7 et B126 en M7 ?

Il faut d'abbord qu'il y'ai tous les A dans chaque poule puis tous les B et enfin les C (onglet liste equipe avec le random)

Je calculerai le nombre de poule à la "main"

 

[job75]

Bonjour Crespo, le forum,

Il faut d'abbord qu'il y'ai tous les A dans chaque poule puis tous les B et enfin les C (onglet liste equipe avec le random)

Alors voyez le fichier joint et cette macro dans le code de la feuille "TIRAGE" :

Private Sub Worksheet_Activate()
Dim tablo, e, n&, source$(), ub&, c As Range, P As Range, i%
tablo = Sheets("Feuil1").[C1].CurrentRegion.Offset(1)
For Each e In tablo 'balayage d'abord par colonne puis par ligne
    If e <> "" Then
        n = n + 1
        ReDim Preserve source(1 To n)
        source(n) = e
    End If
Next e
ub = n
n = 0
Application.ScreenUpdating = False
For Each c In UsedRange
    If c = "N° Equipe" Then
        c(2).Resize(4, 2) = "" 'RAZ sur 2 colonnes
        Set P = Union(IIf(P Is Nothing, c(2), P), c(2))
    End If
Next c
For i = 1 To 4
    For Each c In P
        n = n + 1
        If n > ub Then Exit Sub
        c(i) = source(n)
Next c, i
End Sub

Elle se déclenche quand on active la feuille.

A+

 

[Crespo]

Bonsoir,

voici mon fichier "final", ma macro ne marche plus , que pensez vous des formules et design de l'ensemble des onglets ?

je trouve pas ca très sympa visuellement.

Merci

 

[job75]

Bonjour Crespo, le forum,

1) Vous n'avez pas daigné dire ce que vous pensez du fichier du post #32.

2) Sur votre feuille "RANDOM EQUIPES" la macro du bouton "Tirages" ne fonctionne pas parce que vous avez mis un renvoi à la ligne à la fin de chaque cellule C1 D1 E1, il suffit de l'enlever.

3) Dans la feuille "TIRAGE 1ER TOUR" vos formules n'ont pas de sens.

A+

 

[job75]

Dans la feuille "TIRAGE 1ER TOUR" j'ai mis la macro du post #32 pour remplir la feuille.

 

[Crespo]

Dans la feuille "TIRAGE 1ER TOUR" j'ai mis la macro du post #32 pour remplir la feuille.

merci, c'est normal que je peux pas rapatrier le noms des equipes sur l'onglet "tirage au 1er"
Il écrase ma "recherchev"

 

[Crespo]

Bonjour,

j'ai une demande complémentaire a effectuer le sur le fichier

onglet random equipes :
changer le A par RDM
change le B par FR
supprimer le C

onglet tirage 1er tour :
il faut placer les équipes qui commence par RDM sur la ligne 1 et 3 puis les équipes FR qui complète les tableaux (afin que chaque équipe RDM rencontre une FR)

Merci

 

[job75]

Bonjour Crespo,

Voyez le fichier joint et les macros adaptées, celle de la feuille TIRAGE 1ER TOUR :

Private Sub Worksheet_Activate()
Dim tablo, n&, c As Range
tablo = Sheets("RANDOM EQUIPES").[C1].CurrentRegion.Resize(, 2)
Application.ScreenUpdating = False
On Error Resume Next
For Each c In UsedRange
    If c = "N° Equipe" Then
        c(2).Resize(4, 2) = "" 'RAZ sur 2 colonnes
        n = n + 2
        c(2) = tablo(n, 1)
        c(3) = tablo(n, 2)
        c(4) = tablo(n + 1, 1)
        c(5) = tablo(n + 1, 2)
    End If
Next c
End Sub

A+

 

[Crespo]

Bonjour Crespo,

Voyez le fichier joint et les macros adaptées, celle de la feuille TIRAGE 1ER TOUR :

Private Sub Worksheet_Activate()
Dim tablo, n&, c As Range
tablo = Sheets("RANDOM EQUIPES").[C1].CurrentRegion.Resize(, 2)
Application.ScreenUpdating = False
On Error Resume Next
For Each c In UsedRange
    If c = "N° Equipe" Then
        c(2).Resize(4, 2) = "" 'RAZ sur 2 colonnes
        n = n + 2
        c(2) = tablo(n, 1)
        c(3) = tablo(n, 2)
        c(4) = tablo(n + 1, 1)
        c(5) = tablo(n + 1, 2)
    End If
Next c
End Sub

A+

merci, juste une remaque, il faudrait que tu fasses des poules complets par les FR si on a plus d'equipes RDM

 

[Crespo]

merci, juste une remaque, il faudrait que tu fasses des poules complets par les FR si on a plus d'equipes RDM

Regarde la pièce jointe 1169190

Un complément, il faut dabbord que la première soit rdm par rapport aux nombres de.poule, Puis la 3ème ligne et dès que.le.rdm.est.vide, on finit par le FR

 

[job75]

Joignez le fichier avec le résultat à obtenir.

 

[job75]

Bon je reprends le principe de la macro du post #32, voyez si ça vous convient :

Private Sub Worksheet_Activate()
Dim tablo, e, n&, source$(), ub&, c As Range, P As Range
tablo = Sheets("RANDOM EQUIPES").[C1].CurrentRegion.Offset(1)
For Each e In tablo 'balayage d'abord par colonne puis par ligne
    If e <> "" Then
        n = n + 1
        ReDim Preserve source(1 To n)
        source(n) = e
    End If
Next e
ub = n
n = 0
Application.ScreenUpdating = False
For Each c In UsedRange
    If c = "N° Equipe" Then
        c(2).Resize(4, 2) = "" 'RAZ sur 2 colonnes
        Set P = Union(IIf(P Is Nothing, c(2), P), c(2))
    End If
Next c
For Each e In Array(1, 3, 2, 4) 'ordre des lignes
    For Each c In P
        n = n + 1
        If n > ub Then Exit Sub
        c(e) = source(n)
Next c, e
End Sub