Microsoft 365 Générer aléatoirement sans doublons

[Claudy]

Bonsoir et bon dimanche,
en vba , comment générer aléatoirement dans une colonne du plus petit au plus grand une série de nombres entiers, sans doublon, compris entre 1 et 50?
Merci d'avance,

Claudy

 

[Staple1600]

Bonjour

En A1
=ALEA()
En B1
=RANG(A1;$A$1:$A$50)

Puis recopier vers le bas jusqu'à la ligne 50

PS: Il y aura parfois des doublons mais à la marge.

 

[sylvanu]

Bonjour Claudy,
Un essai en PJ.
... et un autre en PJ2.

 

[Claudy]

Bonjour

En A1
=ALEA()
En B1
=RANG(A1;$A$1:$A$50)

Puis recopier vers le bas jusqu'à la ligne 50

PS: Il y aura parfois des doublons mais à la marge.

Bonsoir et merci,
mais ça va pas...tous des 1.

Claudy

 

[Dranreb]

Bonjour.
Mon objet ListeAléat est muni d'une méthode PartieClassée pour ressortir ça.

 

[Staple1600]

Re

@Claudy
C'est dans la colonne B qu'il y aura les chiffres aléatoires

Il y a deux formules à utiliser : une en colonne A et une en colonne B

 

[Staple1600]

Re

Ci-dessous deux autres formules
(Par commodité, j'utilise cette petite macro pour insérer les formules)

Sub Pour_Test()
[A1:A50].FormulaR1C1 = "=RANDBETWEEN(1,50)"
[B1:B50].FormulaR1C1 = "=RANK.EQ(RC[-1],R1C1:R50C1)+COUNTIF(R1C1:RC[-1],RC[-1])-1"
End Sub

Normalement, il n'y a pas de doublons en colonne B alors qu'il y en aura en colonne A
Appuyer plusieurs fois sur F9 pour vérifier.

 

[Staple1600]

Re

@Claudy
Puisque tu utilises Office 365, autant en profiter

Sub Pour_Test_O365()
[A1].Formula2R1C1 = "=RANDARRAY(50,1,1,50,1)"
[B1:B50].FormulaR1C1 = "=RANK.EQ(RC[-1],R1C1:R50C1)+COUNTIF(R1C1:RC[-1],RC[-1])-1"
End Sub

Dommage, que TABLEAU.ALEA ne dispose pas d'une option : sans doublons

 

[Claudy]

Merci à tous,
j'ai opté pour la méthode Sylvanu(Alea 2)...sur plusieurs colonnes.

Merci à vous tous,

Bon WK,

Claudy

 

[job75]

Bonjour Claudy, JM, sylvanu, Bernard,

Autre solution VBA, facile à comprendre :

Sub Tirages()
Dim N, i, r
N = Val(Application.InputBox("Nombre entier entre 1 et 50 :"))
If N <> Int(N) Or N < 1 Or N > 50 Then Exit Sub
ReDim a(1 To N, 1 To 1)
For i = 1 To N
    Do
        r = Application.RandBetween(1, 50)
    Loop While IsNumeric(Application.Match(r, a, 0))
    a(i, 1) = r
Next
'---restitution---
Application.ScreenUpdating = False
With [A2]
    .Resize(N) = a
    .Resize(N).Sort .Cells, xlAscending, Header:=xlNo 'tri
    .Offset(N).Resize(Rows.Count - N - .Row + 1).ClearContents 'RAZ en dessous
End With
End Sub

A+

 

[Dranreb]

Au cas où ce qui vous gênait dans ma solution c'était de l'obtenir par une formule utilisant une fonction perso, j'ai aussi ajouter une worksheet_Change qui les met dans les colonnes à partir de la 4.

 

[mapomme]

Bonsoir à tous,

Pour le FUN, une méthode par formule et une méthode par vba uniquement pour O365 (garanti sans doublon pour @Staple1600 que je salue).

La formule en B2 sur la feuille "Formule O365" (la cellule A2 contient le nombre max de la séquence):

=SIERREUR(TRANSPOSE(INDEX(TRIER(ASSEMB.V(SEQUENCE(1;A2);TABLEAU.ALEA(1;A2));2;1;1);1;0));"")

Application en VBA sur la feuille "VBA O365" :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim N&
   If Intersect(Target, [a2]) Is Nothing Then Exit Sub
   N = [a2]
   [b2].Resize(Rows.Count - 1).ClearContents
   If N < 1 Then Exit Sub
   [b2].Formula2 = Replace("=TRANSPOSE(INDEX(SORT(VSTACK(SEQUENCE(1,xx),RANDARRAY(1,xx)),2,1,1),1,0))", "xx", N)
   [b2].Resize(N) = [b2].Resize(N).Value
End Sub

 

[mapomme]

Bonsoir à tous,

Ma p'tite version VBA (toutes versions) pour la question de @Claudy.
C'est une fonction générique VBA qui renvoie un tableau d'une colonne.
Il y a trois paramètres : le nombre d'élément à retourner, la borne min de la séquence, la borne max de la séquence : Alea_N_Min_Max(combien, Min, Max)

Exemples :

• Alea_N_Min_Max(20, -15, 30) renvoie un array à 20 lignes et 1 colonne comprenant 20 entiers sans doublon entre -15 et 20
• Alea_N_Min_Max(13, 1 ,50) renvoie un array à 13 lignes et 1 colonne comprenant 13 entiers sans doublon entre 1 et 50

L'avantage d'une fonction retournant un array est qu'on peut aussi l'utiliser directement sur une feuille de calcul en O365.

Code de la fonction générique:

Function Alea_N_Min_Max(ByVal combien&, ByVal Min&, ByVal Max&)
Dim i&, j&, k&, n&, aux
   If Min > Max Or combien <= 0 Or combien > Abs(Min - Max) + 1 Then ReDim r(1 To 1, 1 To 1): r(1, 1) = CVErr(xlErrRef): Alea_N_Min_Max = r: Exit Function
   n = (Max - Min + 1): Randomize
   If combien = 1 Then ReDim t(1 To 1, 1 To 1): t(1, 1) = "": Alea_N_Min_Max = Min + Int(n * Rnd): Exit Function
   ReDim t(Min To Max, 1 To 1): For i = Min To Max: t(i, 1) = i: Next
   For j = 1 To 5: For i = Min To Max: k = Min + Int(n * Rnd): aux = t(i, 1): t(i, 1) = t(k, 1): t(k, 1) = aux: Next i, j
   ReDim r(1 To combien, 1 To 1): For i = 1 To combien: r(i, 1) = t(Min + i - 1, 1): Next
   Alea_N_Min_Max = r
End Function

Code de la procédure lié au bouton Hop! :

Sub Hop()
Dim x
   Application.ScreenUpdating = False
   Range("c2").Resize(Rows.Count - 1).ClearContents
   x = Alea_N_Min_Max([a6], [a2], [a4])
   Range("c2").Resize(UBound(x)) = x
   ' tri optionnel
   'Range("c2").Resize(UBound(x)).Sort key1:=Range("c2"), order2:=1, Header:=xlNo
End Sub

 

[Claudy]

Merci à tous,
j'analyse ça demain matin ou lundi...vous dit quoi, en retour de votre aide, merci.
Bonne soirée à tous,
merci,

Claudy

 

[patricktoulon]

Bonsoir et bon dimanche,
en vba , comment générer aléatoirement dans une colonne du plus petit au plus grand une série de nombres entiers, sans doublon, compris entre 1 et 50?
Merci d'avance,

Claudy

bonjour à tous
pour moi en vba la meilleur solution en terme de temps et d'exeption de double potentiels
et le mélange astuce que j'ai adopté de @mapomme me semble t il
le truc consiste a faire une liste de nombre dans l'ordre et de la mélanger

pourquoi
et bien par ce que les fonctions vba ou excel rnd alea etc.... ne garantissent pas l'exeption des doubles sauf bricolage formule ou test vba et dictionnaire ou vba collection

donc oui j'utilise la fonction "RND" mais elle n'a aucune incidence car c'est juste pour le mélange
en gros par exemple j'inverse l'item 5 avec le 28 ou encore 17 avec le 50 etc....
dans une boucle du min au max d'item ce qui fait que tout les items sont déplacé au moins une fois

voila il n'y a pas de test d'existence nécessaire à faire car justement il ne peut pas y avoir de doublons

remerciez @mapomme pour cette astuce intelligente
donc de cette excellente idée j'en ai fait une fonction

la fonction retourne un tableau
elle peut être utiliser en matricielle
elle est utilisable en vba aussi

Sub test()
    Dim tbl, maxQ, Minx
    Minx = 1: maxQ = 50
    tbl = GenerateWithoutDouble(Minx, maxQ)
    [A1].Resize(maxQ) = tbl
End Sub

'la fonction
Function GenerateWithoutDouble(Minx, maxQ)
    Dim x, i&, y&
    x = Evaluate("ROW(" & Minx & ":" & maxQ & ")")'création du tableau de minx à maxq
    For i = 1 To UBound(x)'mélange du premier au dernier
        y = (1 + (Rnd * 49)): temp = x(i, 1)
        x(i, 1) = x(y, 1): x(y, 1) = temp
        GenerateWithoutDouble = x'return du tableau
    Next
End Function