Randomize liste à copier sans doublon

jamespatagueul

XLDnaute Occasionnel
Bonjour Le forum, et meilleur voeux pour cette année.

je cherche a :
coller aléatoirement les données d'une liste sans doublon.

Merci d'avance
 

Pièces jointes

  • menu auto sans doublon.xlsm
    78.1 KB · Affichages: 43
Dernière édition:

Dranreb

XLDnaute Barbatruc
Bonjour.
D'ordinaire je procède comme ceci pour établir une liste aléatoire sans doublon :
VB:
Sub ListeAléat(TNAlé() As Long, ByVal Nombre As Long)
Dim P As Long, A As Long, J As Long
ReDim TNAlé(1 To Nombre): For P = 1 To Nombre: TNAlé(P) = P: Next P
Randomize
For P = Nombre To 2 Step -1
   A = Int(Rnd * P) + 1: J = TNAlé(A): TNAlé(A) = TNAlé(P): TNAlé(P) = J
   Next P
End Sub

Sub Test()
Dim TN() As Long, TS() As String, PMax, P As Long, ZRés As String
Do:
   PMax = Val(InputBox(ZRés & "Nombre d'éléments", "Tirage", "10"))
   If PMax = 0 Then Exit Do
   ListeAléat TN, PMax
   ReDim TS(1 To PMax)
   For P = 1 To PMax: TS(P) = Chr$(TN(P) + 64): Next P
   ZRés = Join(TS, ", ") & "." & vbLf & vbLf
   Loop
End Sub
 

Dranreb

XLDnaute Barbatruc
Voila un autre exemple d'utilisation via une fonction qui renvoie les valeurs mélangées d'une plage ou de la 1ère colonne d'un tableau 2d spécifié en paramètre :
VB:
Option Explicit

Sub Test2()
With ActiveSheet.[B2].Resize([B1000000].End(xlUp).Row - 1)
   .Offset(, 1).Value = ValeursMélangées(.Value)
   End With
End Sub

Function ValeursMélangées(ByVal ListOrg)
Dim TOrg(), TMél(), TAlé() As Long, L As Long
If TypeOf ListOrg Is Range Then TOrg = ListOrg.Value Else TOrg = ListOrg
ListeAléat TAlé, UBound(TOrg, 1)
ReDim TMél(1 To UBound(TOrg, 1), 1 To 1)
For L = 1 To UBound(TOrg, 1): TMél(L, 1) = TOrg(TAlé(L), 1): Next L
ValeursMélangées = TMél
End Function

Sub ListeAléat(TNAlé() As Long, ByVal Nombre As Long)
Dim P As Long, A As Long, J As Long
ReDim TNAlé(1 To Nombre): For P = 1 To Nombre: TNAlé(P) = P: Next P
Randomize
For P = Nombre To 2 Step -1
   A = Int(Rnd * P) + 1: J = TNAlé(A): TNAlé(A) = TNAlé(P): TNAlé(P) = J
   Next P
End Sub
 
Dernière édition:

Discussions similaires

Réponses
3
Affichages
214
Réponses
6
Affichages
438

Statistiques des forums

Discussions
311 720
Messages
2 081 910
Membres
101 837
dernier inscrit
Ugo