Recherche & référence Rand_Between_Nodouble

[patricktoulon]

Bonjour à tous
en attendant que je trouve l'astuce avec une formule excel de pouvoir faire une serie de nombre aléatoires sans doublons
j'ai créé la mienne dans une fonction perso
dans la video je montre comment je la met en application

'------------------------------------------------------------------------------------------
'Created By patrickoulon
'------------------------------------------------------------------------------------------
'   FR:
'Fonction alea perso "AleaNotDouble" Created By patrickoulon qui ne génère pas de doulons
'selectionner  la plage de cellule ou vous voulez que la serie soit inscrite
'Attention le nombre de cellulles ne doit pas dépasser l'intervalle entre mini et maxi
'elle fonctionne sur  une selection horizontale (1 ligne et plusieurs colonnes) ou  (plusieurs lignes et 1 colonne)
'Exemple pour 10 cellules :formule ---> =AleaNoDouble(1:10)
'Exemple pour 10 cellules :formule ---> =AleaNoDouble(35;45)
'sur les version anterieures  à  2019 valider en matricielle (CTRL+MAJ+ENTER)
'------------------------------------------------------------------------------------------
'   US:
'Personal alea function "AleaNotDouble" Created By patrickoulon which does not generate pain
'select the cell range where you want the series to be entered
'be careful the number of cells must not exceed the interval between mini and maximum
'it works on a horizontal selection (1 line and several columns) or (several lines and 1 column)
'Example for 10 cells: formula ---> =AleaNoDouble(1:10)
'Example for 10 cells: formula ---> =AleaNoDouble(35;45)
'on versions prior to 2019 validate in matrix (CTRL+SHIFT+ENTER)
'------------------------------------------------------------------------------------------

Function Rand_Between_NoDouble(mini As Long, maxi As Long, Optional Dimension As Long = 1) As Variant
'variable utile
    Dim tbl, I&, X&, Temp, R As Range

    'FR: Gestion des erreurs eventuelles d'appel / US: 'Management of possible call errors
    If maxi < mini Then Rand_Between_NoDouble = "Err.min": Exit Function

    On Error Resume Next
    Set R = Application.Caller
    Err.Clear
    On Error GoTo 0
  
    If Not R Is Nothing Then
        If R.Cells.Count > 1 Then If (maxi - mini) > Application.Caller.Cells.Count Then Rand_Between_NoDouble = "Err.count": Exit Function
    End If
  
    'FR:creation du tableau (1 dimension)de nombres dans l'ordre avec evaluate transpose et ROW
    'US:creation of array (1 dimension) of numbers in order with evaluate transpose and ROW
    tbl = Evaluate("TRANSPOSE(ROW(" & mini & ":" & maxi & "))")

    'FR:boucle sur tout les items de la variable tableau(tbl)
    'US: loop over all the items of the table variable (tbl)
    For I = LBound(tbl) To UBound(tbl)

        'FR:on choisi un autre index au hasard / US: we choose another index at random
        X = LBound(tbl) + (Rnd * (UBound(tbl) - LBound(tbl)))

        'FR:on interverti l'item(i) avec l'item(x) / US: we invert item(i) with item(x)
        Temp = tbl(I): tbl(I) = tbl(X): tbl(X) = Temp
    Next

    'FR:si la fonction  a été appelée par une plage de cellules en formule matricielle
    'US:if the function was called by a range of cells in array formula

    'FR:si le caller est une colonne on transpose sinon il restera un tableau a 1 dimension
    'US: if the caller is a column we transpose otherwise it will remain a 1-dimensional table
    If TypeName(R) = "Range" Then If Application.Caller.Rows.Count > 1 Then tbl = Application.Transpose(tbl)
    
    'FR:si la fonction a été appelée en vba / US:if the function was called in vba
    If R Is Nothing Then If Dimension = 2 Then tbl = Application.Transpose(tbl)

    'FR:retour de la fonction / US:return of function
    Rand_Between_NoDouble = tbl
End Function

'----------------------------------------------------------------------------
Sub test1()
    'on obtiendra un tableau à 1 dimension
  X = Rand_Between_NoDouble(15, 25)
    MsgBox X(1)
End Sub

Sub test2()
   'on obtiendra un tableau à 2 dimensions
   X = Rand_Between_NoDouble(15, 25, 2)
    MsgBox X(1, 1)
End Sub