XL 2010 Tirage aléatoire sans doublon

[saddok]

je dispose d'un fichier Excel 2010 d'une liste nominative (nom-prenom-matricule) d'environ 1500 personnes.

Je dois extraire aléatoirement de cette liste 20% des personnes. Le pourcentage 20% pouvant être revu

Quelqu'un pourrait-il m'aider à réaliser une macro ?

D'avance MERCI

 

[Staple1600]

Bonjour à tous

saddok

je dispose d'un fichier Excel 2010

Et tu disposes d'un clavier et pourtant t'oublies de dire bonjour à tes petits camarades de jeu... Rooohhh

En plus du bonjour, si tu rajoutais un fichier Excel, afin qu'on essaie nos macros avant de te les proposer, ça pourrait être pas mal, non ?

 

[saddok]

Merci ta réponse rapide et désolé pour le Bonjour
Ci-joint un exemple de fichier
Mille Mercis d'avance pour ton aide

 

[pierrejean]

Bonjour
Salut l'agrafe

Un essai

 

[Staple1600]

Un essai par formule
(pour faire le tirage, appuies sur F9)

EDITION: Bonsoir pierrejean

 

[Dranreb]

Bonjour.
Un autre code.

 

[mapomme]

Bonsoir à tous,

Et un autre code...

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

 

[Modeste geedee]

Bonsour®

je dispose d'un fichier Excel 2010 d'une liste nominative (nom-prenom-matricule) d'environ 1500 personnes.

Je dois extraire aléatoirement de cette liste 20% des personnes. Le pourcentage 20% pouvant être revu

sans macro :

 

[Staple1600]

Bonsoir Modeste Geedee

Sans macro, le matricule en plus et la finition en bonus

Sans macro (pour moi également) mais le matricule en moins
(voir message #5)

 

[saddok]

Bonsour®
sans macro :
Regarde la pièce jointe 970110

Bonjour,
Un grand merci pour vos solutions
Petite question : a quoi serve les colonnes D & E ?
MERCI

 

[Modeste geedee]

Bonsour®

Bonjour,
Un grand merci pour vos solutions
Petite question : a quoi serve les colonnes D & E ?
MERCI

génération aléatoire de rang (sans doublon)

 

[CISCO]

Bonjour à tous

Bonjour
Salut l'agrafe

Un essai

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

Si quelqu'un pouvait m'expliquer le code de Pierrejean dans le post #4 à partir de Set dico = CreateObject jusqu'à ligne = 2, cela serait bien sympa... Je n'y comprend vraiment pas grand chose. Ne serait-ce que le If findex > 100 : Où est calculée la variable findex ?

@ plus

 

[pierrejean]

Re

Fichier avec code commenté
NB: findex était une erreur et aurait du être index

 

[CISCO]

Bonsoir à tous, bonsoir Pierrejean

Merci pour les commentaires. Je crois que j'ai compris. Je crois...

@ plus