XL 2016 sélection aléatoire de 5% d'une liste

mapomme

XLDnaute Barbatruc

Supporter XLD

• 20 Août 2019

• #2

Bonjour @lplv, bienvenu sur XLD ,

Et où il est le fichier exemple ?

A+

 

Vote positif 0 Vote négatif

L

lplv

XLDnaute Nouveau

• 20 Août 2019

• #3

Bonjour,

Je vous remercie pour votre aide. Il faudrait que ça ressemble à cela.

Peut on automatiser la chose si je change le nombre de projet dans la liste ?

 

Pièces jointes

• Nouveau Feuille de calcul Microsoft Excel.xlsx

  10.6 KB · Affichages: 7

Vote positif 0 Vote négatif

C

CHALET53

XLDnaute Barbatruc

• 20 Août 2019

• #4

Bonjour
Un essai

 

Pièces jointes

• Iplv aléatoire bis.xls

  43 KB · Affichages: 6

Vote positif 0 Vote négatif

pierrejean

XLDnaute Barbatruc

• 20 Août 2019

• #5

Bonjour Iplv
Salut tapomme

Edit: Salut CHALET53

Un exemple

 

Pièces jointes

• Tirage.xlsm

  22.4 KB · Affichages: 11

Vote positif 0 Vote négatif

L

lplv

XLDnaute Nouveau

• 20 Août 2019

• #6

Bonjour @pierrejean ,

je vous remercie grandement, par contre concernant votre fichier je vois qu'il y a une liste de 292 mais que 13 sélectionnés. Or 292x0.05=14.6 donc il faudrait 15 sélectionnés. Comment puis-je corriger cela ?

Merci encore,

Merci également @CHALET53 cela me fais une autre alternative

 

Vote positif 0 Vote négatif

Dranreb

XLDnaute Barbatruc

• 20 Août 2019

• #7

Bonjour.
Un essai avec une formule matricielle utilisant une fonction personnalisée.

*** pièce jointe supprimée, remplacée plus loin. ***

 

Dernière édition: 20 Août 2019

Vote positif 0 Vote négatif

patricktoulon

XLDnaute Barbatruc

• 20 Août 2019

• #8

si je reprend l'exemple de PierreJean sans dictionnaire ca donne ceci

VB:

Sub test2()
    Dim tablo, t, x&, i&, q&
    Randomize
    tablo = Range("A1", Cells(Rows.Count, "A").End(xlUp)).Value
    q = Int(UBound(tablo) * Range("F1"))
    ReDim t(1 To q, 1 To 1)
    Do While i < q
        x = 1 + Round(Rnd * (UBound(tablo) - 1))
        If IsError(Application.Match(tablo(x, 1), t, 0)) Then i = i + 1: t(i, 1) = tablo(x, 1)
    Loop
    Range("C1:C" & q).Value = (t)
End Sub

ca peut être intéressant pour Mac qui n'ont pas le dico a dispo ou ceux qui ne veulent pas se servir des objets scripting...

pour l'arrondi supperieur

Code:

q = Int(UBound(tablo) * Range("F1"))+1

 

Vote positif 0 Vote négatif

L

lplv

XLDnaute Nouveau

• 20 Août 2019

• #9

Bonjour @patricktoulon

Je suis très novice en VBA, ou faudrait-il que s'ajoute cette dernière ligne pour que cela fonctionne en arrondissant au supérieur ?

Merci encore à tous pour votre aide précieuse

 

Vote positif 0 Vote négatif

patricktoulon

XLDnaute Barbatruc

• 20 Août 2019

• #10

re
regarde le code tu dois trouver le même ligne sans le "-1" .. ben tu la remplace
ensuite j'ai zappé le 3 minimum voila qui est corrigé
donc le code sans dico et arrondi sup avec condition 3 minimum ca donne ceci

VB:

Sub test2()
    Dim tablo, t, x&, i&, q&
    Randomize
    tablo = Range("A1", Cells(Rows.Count, "A").End(xlUp)).Value
    q = Application.Max(Int(UBound(tablo) * Range("F1")) + 1, 3)
    ReDim t(1 To q, 1 To 1)
    Do While i < q
        x = 1 + Round(Rnd * (UBound(tablo) - 1))
        If IsError(Application.Match(tablo(x, 1), t, 0)) Then i = i + 1: t(i, 1) = tablo(x, 1)
    Loop
    Range("C1:C" & q).Value = (t)
End Sub

 

Vote positif 0 Vote négatif

L

lplv

XLDnaute Nouveau

• 20 Août 2019

• #11

Je suis vraiment désolée @patricktoulon mais cela ne fonctionne pas car si j'applique votre formule et que j'opte par exemple pour une liste de 120 le nombre de sélectionnés reste à 15 alors qu'il faut que les sélectionnes représentent 5% de la liste. Le modèle de @pierrejean prenait cela en compte

 

Vote positif 0 Vote négatif

pierrejean

XLDnaute Barbatruc

• 20 Août 2019

• #12

Re
Version avec arrondi superieur

 

Pièces jointes

• Tirage.xlsm

  22.6 KB · Affichages: 4

Vote positif 0 Vote négatif

Dranreb

XLDnaute Barbatruc

• 20 Août 2019

• #13

Je re-joins mon classeur avec un paramètre de plus dans ma fonction ListeAl pour ne plus confondre le nombre de résultats souhaités avec le numéro maxi sélectionnable.

 

Pièces jointes

• Temp.xlsm

  22.6 KB · Affichages: 6

Vote positif 0 Vote négatif

L

lplv

XLDnaute Nouveau

• 20 Août 2019

• #14

merci infiniment @pierrejean vous êtes mon sauveur !!

 

Vote positif 0 Vote négatif

L

lplv

XLDnaute Nouveau

• 20 Août 2019

• #15

ouhla déjà de retour, on revient au point de départ je viens de faire un autre test en proposant une liste de 146 mais cela me met 7 sélectionnés au lieu de 8 (146*0.05=7.25 donc 8 à l'arrondi supérieur)

 

Vote positif 0 Vote négatif