Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Tirage au sort sans les blancs

Créer une discussion
  • Initiateur de la discussion Initiateur de la discussion speedball
  • 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 !

S'inscrire
S

speedball

Guest
Bonjour

Je me dirige vers vous pour un coup de main.
Je souhaite faire un tirage aléatoire des cellules non vide (B6-B37) feuille inscriptions
avec un résultat sur la feuille appelé comme la cellule M2
Je joins un fichier Exemple
Je suis dans le flou complet
Malgrès les nombreux post existants, je n'y arrive pas

Merci
 

Pièces jointes

Trier par date Trier par votes
Re : Tirage au sort sans les blancs

Merci

J'ai un souci, quand j'ai voulu mettre cette macro dans mon fichier.
Il me dit que certaines cellules sont vérouillés, si je déverouille les cellules la macro fonctionne.
comment faire pour déproteger la feuille et la reproteger à la fin.
De plus sur la feuille "1er", j'ai des lignes qui se retrouve supprimées ou maquées
J'ai donc tenter de modifier la macro pour que le résultatne soit plus de B1 à B32 de la feuille 1er mais dans les cellules B101 à B132 de la feuille Inscriptions. Je n'ai pas réussi, peut tu m'aider?

Mais un grand merci pour ce travail déjà réalisé
 
Dernière modification par un modérateur:
Vote positif 0 Vote négatif
Re : Tirage au sort sans les blancs

Bonjour,
Voici la façon de procéder pour la protection :
Au début de la macro, tu rajoutes :
ActiveSheet.Unprotect
et à la fin
ActiveSheet.Protect
Si la protection se fait avec mot de passe, les codes sont :
ActiveSheet.Unprotect Password:="Mon_mot_de_passe"et
ActiveSheet.Protect Password:="Mon_mot_de_passe"
Pour le reste, les lignes supprimées correspondent à tes blancs de départ
 
Vote positif 0 Vote négatif
Re : Tirage au sort sans les blancs

Je mouline lorsque je modifie la macro
pour que le résultat soit sur la même feuille
je me retrouve avec des lignes de hauteur 0 (je crois)
et les numéros de lignes deviennent bleu ???
Je crois que ces la sélection de la colonne B qui pose problème
Voici que j'ai modifié

Sub Tirage()
ActiveSheet.Unprotect
Application.ScreenUpdating = False
Sheets("Inscriptions").Select
Range("B100").Select
Selection.AutoFilter
Selection.AutoFilter Field:=2, Criteria1:="<>"
Range("B6:B37").Select
Selection.Copy
Range("B101").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A100").Select
ActiveCell.FormulaR1C1 = "=4*RAND()"
Range("A100").Select
Selection.Copy
Range("A101:A131").Select
ActiveSheet.Paste
Range("A100:B131").Select
Selection.Sort Key1:=Range("A100"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Sheets("Inscriptions").Select
Selection.AutoFilter
Range("B100").Select
Sheets("Inscriptions").Select
Columns("B:B").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="="
Range("B101:B133").Select
Selection.EntireRow.Delete
Range("B101").Select
Sheets("Inscriptions").Select
Range("B100").Select
Application.ScreenUpdating = True
MsgBox " Tirage effectué avec succès ! "
ActiveSheet.Protect
End Sub


Merci
 
Vote positif 0 Vote négatif
Re : Tirage au sort sans les blancs

Bonjour à tous
Essayez ceci :
Code: 
[COLOR="DarkSlateGray"][B]Sub Macro1()
Dim i&, Table(), sDat(), oColl As New Collection, plg As Object
  With Sheets("Inscriptions") [COLOR="Sienna"]'Feuille d'origine.[/COLOR]
    .Unprotect [COLOR="Sienna"]'*si besoin est.[/COLOR]
    Table = .[B6:B37].Value 'Données.
    .Protect [COLOR="Sienna"]'*si besoin est.[/COLOR]
  End With
  On Error Resume Next
  For i = 1 To UBound(Table, 1)
    If Not IsEmpty(Table(i, 1)) And Table(i, 1) <> "" Then oColl.Add Table(i, 1), CStr(Table(i, 1))
  Next i
  ReDim sDat(1 To oColl.Count, 1 To 1)
  i = 0
  On Error GoTo 0
  Randomize
  Do While oColl.Count > 0
    i = i + 1
    sDat(i, 1) = oColl(1 + Int(oColl.Count * Rnd))
    oColl.Remove 1 + Int(oColl.Count * Rnd(0))
  Loop
  Set plg = Sheets("Inscriptions") [COLOR="Sienna"]'Feuille de destination[/COLOR]
  plg.Unprotect [COLOR="Sienna"]'*si besoin est.[/COLOR]
  With plg.[B101] [COLOR="Sienna"]'Cellule de destination[/COLOR]
    .Value = " "
    .Resize(plg.Cells(plg.Rows.Count, .Column).End(xlUp).Row - .Row + 1, 1).ClearContents
    .Resize(UBound(sDat, 1), 1).Value = sDat
  End With
  plg.Protect [COLOR="Sienna"]'*si besoin est.[/COLOR]
End Sub[/B][/COLOR]
C'est aisément adaptable (voir les commentaires).​
ROGER2327
#4345

Dimanche 15 Haha 138 (Nativité de l' Œstre, artificier, ST)
29 Vendémiaire An CCXIX
2010-W42-3T13:45:44Z
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Tirage au sort sans les blancs

Grand merci
Ca fonctionne j'ai juste ajouter des lignes car le résultats arrive dans des lignes masquées. Donc je les affiche puis les caches

A+
 
Vote positif 0 Vote négatif
Re : Tirage au sort sans les blancs

Bonjour

Je souhaite changer la destination par un nom de feuille qui est une variable = au contenu de la cellule M2 de la feuille Inscriptions. J'ai donc tenter de tenter de changer la macro, mais ca plante sur sur cette ligne Rows("100:140").Select

VOICI le code modifié

code:
Sub Tirage()
Dim i&, Table(), sDat(), oColl As New Collection, plg As Object
With Sheets("Inscriptions") 'Feuille d'origine.
.Unprotect '*si besoin est.
Table = .[B6:B37].Value 'Données.
.Protect '*si besoin est.
End With
On Error Resume Next
For i = 1 To UBound(Table, 1)
If Not IsEmpty(Table(i, 1)) And Table(i, 1) <> "" Then oColl.Add Table(i, 1), CStr(Table(i, 1))
Next i
ReDim sDat(1 To oColl.Count, 1 To 1)
i = 0
On Error GoTo 0
Randomize
Do While oColl.Count > 0
i = i + 1
sDat(i, 1) = oColl(1 + Int(oColl.Count * Rnd))
oColl.Remove 1 + Int(oColl.Count * Rnd(0))
Loop
Dim j As String
j = Range("Inscriptions!M2").Value
Set plg = Sheets(j) 'Feuille de destination
Sheets(j).Unprotect '*si besoin est.
Rows("100:140").Select
Selection.EntireRow.Hidden = False
With plg.[B101] 'Cellule de destination
.Value = " "
.Resize(plg.Cells(plg.Rows.Count, .Column).End(xlUp).Row - .Row + 1, 1).ClearContents
.Resize(UBound(sDat, 1), 1).Value = sDat
End With
Rows("100:140").Select
Selection.EntireRow.Hidden = True
Sheets(j).Protect '*si besoin est.
MsgBox " Tirage effectué avec succès ! "
End Sub


Quelqu'un peut-il m'aider

Merci d'avance
 
Vote positif 0 Vote négatif
Re : Tirage au sort sans les blancs

Re...
Changer le nom de la feuille de destination n'est pas vraiment le problème puisque le code est prévu pour cela. Le problème est de savoir à quelle feuille appartient la plage Rows("100:140") que vous voulez traiter, ce que vous ne dites pas. En supposant qu'il s'agit de la feuille de destination (nommée en M2 de la feuille Inscriptions), essayez ce code :
Code: 
[COLOR="DarkSlateGray"][B]Sub Tirage()
Dim i&, [COLOR="Red"]j$,[/COLOR] Table(), sDat(), oColl As New Collection, plg As Object
  With Sheets("Inscriptions") 'Feuille d'origine.
    .Unprotect '*si besoin est.
    Table = .[B6:B37].Value 'Données.
    [COLOR="Red"]j = Range("M2").Value[/COLOR]
    .Protect '*si besoin est.
  End With
  On Error Resume Next
  For i = 1 To UBound(Table, 1)
    If Not IsEmpty(Table(i, 1)) And Table(i, 1) <> "" Then oColl.Add Table(i, 1), CStr(Table(i, 1))
  Next i
  ReDim sDat(1 To oColl.Count, 1 To 1)
  i = 0
  On Error GoTo 0
  Randomize
  Do While oColl.Count > 0
    i = i + 1
    sDat(i, 1) = oColl(1 + Int(oColl.Count * Rnd))
    oColl.Remove 1 + Int(oColl.Count * Rnd(0))
  Loop
  Set plg = Sheets(j) 'Feuille de destination
  [COLOR="Red"]plg[/COLOR].Unprotect '*si besoin est.
  [COLOR="Red"]plg.[/COLOR]Rows("100:140").EntireRow.Hidden = False
  With plg.[B101] 'Cellule de destination
    .Value = " "
    .Resize(plg.Cells(plg.Rows.Count, .Column).End(xlUp).Row - .Row + 1, 1).ClearContents
    .Resize(UBound(sDat, 1), 1).Value = sDat
  End With
  [COLOR="Red"]plg.[/COLOR]Rows("100:140").EntireRow.Hidden = True
  [COLOR="Red"]plg[/COLOR].Protect '*si besoin est.
  MsgBox " Tirage effectué avec succès ! "
End Sub[/B][/COLOR]
ROGER2327
#4383

Samedi 21 Haha 138 (Zimzoum de Bosse-de-Nage, ST)
5 Brumaire An CCXIX
2010-W43-2T16:45:57Z
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- 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
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

  • Question Question
XL 2021 Besoin aide sur macro en VBA
Réponses
0
Affichages
259
Francoise_nord
S
  • Résolu(e)
Microsoft 365 Tirage au sort de 2 numéros sans doublon
Réponses
7
Affichages
416
Sissou71
S
S
  • Question Question
XL 2019 Fichier de tirage au sort sans doublons avec valeurs en plus
Réponses
1
Affichages
489
sylvanu
M
  • Question Question
XL 2021 macro pour faire un tirage au sort
Réponses
4
Affichages
890
marco22
M
  • Question Question
XL 2019 Tirage au sort avec nombre variable
Réponses
14
Affichages
1 K
Frederic14
S
  • Résolu(e)
XL 2021 "Blocage de la mise a jour d'une cellule"
Réponses
8
Affichages
544
Steph733
S
G
  • Question Question
XL 2019 Tirage au sort
2 3
Réponses
30
Affichages
3 K
gg13
G
O
  • Question Question
XL 2016 transférer les données d'un tableau brut, dans un autre format pour analyse.
Réponses
12
Affichages
785
ORL
O
J
  • Question Question
XL 2013 tirage au sort petanque
Réponses
13
Affichages
4 K
jpg17
J
  • Question Question
XL 2019 Correspondance après tirage au sort
Réponses
2
Affichages
843
Mapat
S
  • Question Question
XL 2016 Tirage au sort parmi une liste sans doublons
Réponses
1
Affichages
5 K
job75
  • Question Question
XL 2019 Résultat d'une liste déroulante en cascade sans underscore "_"
Réponses
9
Affichages
1 K
fanch55
  • Question Question
XL 2013 Tirage au sort Équipe avec conditions
Réponses
0
Affichages
2 K
Francoise_nord
I
  • Résolu(e)
Microsoft 365 Tirage au sort avec handicap
Réponses
8
Affichages
3 K
Informatique661
I
N
  • Question Question
XL 2019 Tirage au sort sujet examen sans remise
2
Réponses
19
Affichages
4 K
nanie
N
E
  • Question Question
Microsoft 365 VBA Calendrier, rien ne se passe.
Réponses
12
Affichages
1 K
fanch55
J
  • Question Question
XL 2016 Besoin d'aide tirage au sort sans doublons
Réponses
3
Affichages
2 K
Dranreb
S
  • Question Question
XL 2010 VBA - macro avec 1 boucle qui alterne 1 action à conditions et 1 action sans conditions
2 3 4
Réponses
58
Affichages
9 K
Scorp0211
S
C
  • Résolu(e)
XL 2010 Tirage au sort d'équipes avec conditions en VBA
2 3
Réponses
40
Affichages
8 K
Pounet95
P
H
  • Question Question
XL 2013 Double tirage au sort : éviter les doublons
Réponses
2
Affichages
2 K
Hrouxel974
H
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…