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 !
Et tu disposes d'un clavier et pourtant t'oublies de dire bonjour à tes petits camarades de jeu... Rooohhh
Sub Tirage()
Dim T, R, i&, ii&, aux, N&
With Feuil1
.Range("i2:k" & Rows.Count).ClearContents 'effacement dernier tirage
Application.ScreenUpdating = False
T = .Range("a1:c1").Resize(.Cells(Rows.Count, "a").End(xlUp).Row) 'acquisition données
If UBound(T) = 1 Then Exit Sub 'test si aucune donnée
ReDim R(1 To UBound(T)) 'tableau des numéros de lignes
For i = 2 To UBound(T): R(i) = i: Next i
Randomize 'reset du générateur de nombres aléatoires
For i = 2 To UBound(T) 'mélange du tableau des numéros de lignes
ii = 2 + Int(Rnd * (UBound(T) - 1))
aux = R(i): R(i) = R(ii): R(ii) = aux
Next i
N = Int((UBound(R) - 1) * .Range("f1")) + 1 'Nbr de lignes à tirer +une
Do 'tri du tableau des numéros de lignes
aux = Empty
For i = 2 To N - 1
If R(i) > R(i + 1) Then
aux = R(i): R(i) = R(i + 1): R(i + 1) = aux
End If
Next i
Loop Until IsEmpty(aux)
'copie des lignes tirées vers le haut du tableau des données
For i = 2 To N: For ii = 1 To 3: T(i, ii) = T(R(i), ii): Next ii: Next i
.Range("i1").Resize(N, 3) = T 'écriture des lignes tirées au sort
End With
End Sub
Bonjour,
génération aléatoire de rang (sans doublon)
Sub tirage()
Randomize
Range("I2:ZZ" & Rows.Count).ClearContents
tablo = Sheets("Feuil1").Range("A1:C1500")
Set dico = CreateObject("Scripting.dictionary")
For n = LBound(tablo, 1) To UBound(tablo, 1)
x = tablo(n, 1)
dico(x) = x
Next
a = dico.keys
Set dico1 = CreateObject("Scripting.dictionary")
Index = 1
While dico1.Count < Range("F1")
x = Int((UBound(a)) * Rnd)
dico1(x) = x
Index = Index + 1
If findex > 100 Then Exit Sub
Wend
b = dico1.keys
ligne = 2
colonne = 8
For n = LBound(b) To UBound(b)
For m = LBound(tablo, 2) To UBound(tablo, 2)
Cells(ligne, colonne + m) = tablo(b(n), m)
Next
ligne = ligne + 1
Next
End Sub
