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

  • Initiateur de la discussion Initiateur de la discussion Claudy
  • 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 !

Claudy

XLDnaute Accro
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
 
Re

Ci-dessous deux autres formules
(Par commodité, j'utilise cette petite macro pour insérer les formules)
Code:
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.
 
Re

@Claudy
Puisque tu utilises Office 365, autant en profiter 😉
Code:
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
 
Dernière édition:
Bonjour Claudy, JM, sylvanu, Bernard,

Autre solution VBA, facile à comprendre :
VB:
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+
 

Pièces jointes

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):
VB:
=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" :
VB:
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
 

Pièces jointes

Dernière édition:
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:
VB:
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! :
VB:
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
 

Pièces jointes

Dernière édition:
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


VB:
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
 
- 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

Discussions similaires

Réponses
2
Affichages
384
Réponses
26
Affichages
1 K
Réponses
2
Affichages
809
Retour