Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Re tirrage Aléatoire

Re tirrage Aléatoire

11 réponses
Avatar
Fredy
Bonjour =E0 tous,
Cette macro ci-jointe, pour tirrage al=E9atoire de Fred, avec une
protection en colonne B par champ de 2 cad B1:B2 etc marche super
bien.
Mais une question me reste sur le clavier, est-il possible,
d'augmenter cette protection en colonne B par champ de 4 cad
B1:B4,B5:B8 et de suite.

Sub Bouton2_QuandClic()
' Tirage al=E9atoire avec protection en colonne B
' Macro de Fred 13/12/2006.
' Sub tiragep=E9tanque()
Application.ScreenUpdating =3D False
Dim doublon As Boolean
Dim c As Range, sel As Range
doublon =3D False
Set sel =3D Range([A1], [A1].End(xlDown))
Do
For Each c In sel ' tirage al=E9atoire
Cells(c.Row, 3) =3D Rnd
Next c
[A:C].Sort key1:=3DRange("C1") ' tri selon al=E9a
[C:C].Clear
For Each c In sel ' v=E9rification
If c.Row Mod 2 <> 0 Then doublon =3D (c.Offset(0, 1) =3D
c=2EOffset(1, 1))
If doublon Then Exit For
Next c
Loop Until Not doublon
Application.ScreenUpdating =3D True
End Sub

Je vous remercie d'avance pou toutes r=E9ponses.
Fredy
Signaler un problème avec ce contenu

1 réponse

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2
Avatar
lSteph
Re,

en complément pour les versions xl97 éviter le bug du focus qui reste
collé sur le bouton
Provoquant ici par exemple "impossible de définir la propriété..."
en ajoutant cette instruction qui peut paraître absurde:
Activecell.select

Sub tirage()
Dim lig As Long, col As Byte, i As Byte, j As Long, c As Range
ActiveCell.Select '''''''''''''''''''''''''''''''''' ici
lig = [e2].CurrentRegion.Rows.Count

'.....






On 2 avr, 09:18, LSteph wrote:
Bonjour,

Pour les poules forfaitaires j'ai choisis l'idée de mettre des xxxx
il y aura des autoqualifiés!

http://cjoint.com/data/ecjnGloJaT.htm

Sub tirage()
Dim lig As Long, col As Byte, i As Byte, j As Long, c As Range

lig = [e2].CurrentRegion.Rows.Count
col = [iv2].End(xlToLeft).Column
Application.ScreenUpdating = False
[a2:b65536].ClearContents
For Each c In [e2].CurrentRegion.Cells
If IsEmpty(c) Then c = "xxxxx"
Next
Randomize
For Each c In Range(Cells(lig + 1, 5), Cells(lig + 1, col))
c = Rnd
Next
Range("e1", Columns(col)).Sort _
Key1:=Range(Cells(lig + 1, 5), Cells(lig + 1, col)), _
Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:úlse, _
Orientation:=xlLeftToRight
Range(Cells(lig + 1, 5), Cells(lig + 1, col)).ClearContents

For i = 5 To col
For Each c In Range(Cells(2, 4), Cells(lig, 4)).Cells
c = Rnd
Next c
Range(Cells(2, 4), Cells(lig, i)).Sort _
Key1:=Range(Cells(2, 4), Cells(lig, 4)), _
Order1:=xlAscending, _
Header:=xlNo, OrderCustom:=1, MatchCase:úlse, _
Orientation:=xlTopToBottom
Next i
Range(Cells(2, 4), Cells(lig, 4)).ClearContents

For Each c In Range([e2], Cells(lig, col)).Cells
With [a65536].End(xlUp)(2)
.Cells(1) = c
.Offset(0, 1) = Cells(1, c.Column)
End With
Next c
End Sub


http://cjoint.com/?ebvHICvQxP




1 2