Discussion :

[gigalia]

Bonjour,

Voila, j'ai une liste de nom de personnes et je souhaite avoir une autre liste dans un ordre aléatoire de ces personnes sans qu'il n'y ait jamais 2 fois la même personne.

A savoir que dans la première liste il n'y a pas 2 fois le même nom..

J'ai le code suivant pour le moment pour la partie "aléatoire" :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Sub liste()
 
For i = 1 To 12
 
Range("C" & i) = Range("B1").Offset(Int((12 * Rnd) + 1), 0)
 
Next i
 
End Sub

Il me manque l'astuce pour la partie jamais 2 fois le même.

Merci pour votre aide.

[Invité]

Bonjour,
un ordre aléatoire ça s'appel le désordre!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
dim DejaTrouver as string
dim txt as string
txt= Range("B1").Offset(Int((12 * Rnd) + 1), 0)
if instr(1,";"  & DejaTrouver  & ";",";" &  txt & ";")=0 then  Range("C" & i) =txt
DejaTrouver=DejaTrouver & ";" & txt & ";"

[gigalia]

Bonjour,

Merci pour ta réponse mais il y a un problème. Ton code me laisse des trous et ne reporte pas l'intégralité de la première liste dans un ordre différent.

[Invité]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Sub liste()
dim DejaTrouver as string
dim txt as string
For i = 1 To 12
     txt= Range("B1").Offset(Int((12 * Rnd) + 1), 0)
     if instr(1,";"  & DejaTrouver  & ";",";" &  txt & ";")=0 then  Range("C" & i) =txt : DejaTrouver=DejaTrouver & ";" & txt & ";"  else i=i-1 
Next i
End Sub

[mercatog]

Autrement

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub TriAlea()
Dim Nb As Integer, i As Integer, j As Integer
Dim Tmp As String
Dim Tb
 
Nb = 12
With Worksheets("Test")    'à adapter
    Tb = .Range("B1").Resize(Nb)
    For i = 1 To Nb
        Do
            Randomize
            j = Int((Nb - 1) * Rnd()) + 1
        Loop Until i <> j
 
        Tmp = Tb(i, 1)
        Tb(i, 1) = Tb(j, 1)
        Tb(j, 1) = Tmp
    Next i
    .Range("C1").Resize(Nb) = Tb
End With
End Sub