tri aleatoire de noms : macro (ou moi) qui bug !!!

[arvin]

bonjour, j'essaie d'adapter le code de Pierre Jean pour un tri aleatoire de noms
Ma colonne a trié, commence à la cellule A2 -> j'aimerai bien qu'elle trie les noms en les plaçant à la colonne G2 (logique !)
pour info , en H1 , il me note le nombre de nom (intéressant)
merci à tous et bon avant reveillon !!!!

Sub tri()
Dim liste As Collection
Set liste = New Collection
nb = Range("A2").End(xlDown).Row - 1
Range("H1") = nb
While liste.Count < nb
Randomize
x = Int((nb * Rnd) + 1)
On Error Resume Next
liste.Add x, CStr(x)
On Error GoTo 0
Wend
For n = 1 To liste.Count
Range("G" & (n + 1)) = Range("A" & liste(n + 1)) -> c'est ici que cela plante !!!!
Next n
End Sub

 

[phlaurent55]

Re : tri aleatoire de noms : macro (ou moi) qui bug !!!

Bonjour Arvin,

voir fichier joint réalisé d'après tes explications:

j'essaie d'adapter le code de Pierre Jean pour un tri aleatoire de noms

à+
Philippe

 

[arvin]

Re : tri aleatoire de noms : macro (ou moi) qui bug !!!

bonjour et merci d'avoir répondu aussi vite
par contre je préfèrerai une solution macro car cette feuill1 est exporté par un logiciel
j'aurai donc besoin de cette feuille qui change tout le temps
merci beaucoup

 

[Fo_rum]

Re : tri aleatoire de noms : macro (ou moi) qui bug !!!

bonsoir

un autre exemple parmi tant d'autres

Sub Tri()
  Dim Nb As Long, N As Long, X As Long
  Dim Plage, Temp
  Nb = Range("A65000").End(xlUp).Row - 1
  [H1] = Nb
  Randomize
  Plage = Range("A2:A" & Nb + 1)
  For N = 1 To Nb
    X = Int(Nb * Rnd + 1)
    If N <> X Then
      Temp = Plage(N, 1)
      Plage(N, 1) = Plage(X, 1)
      Plage(X, 1) = Temp
    End If
  Next
  Range("G2:G" & Nb + 1) = Plage
End Sub

 

[arvin]

Re : tri aleatoire de noms : macro (ou moi) qui bug !!!

bonsoir, merci beaucoup pour le code : je l'essaie à mon bureau l'année prochaine (lol !)
je te tiens au courant
bonne fêtes de fin d'année et merci à tous pour vos implications sur Excel !

 

[ROGER2327]

Re : tri aleatoire de noms : macro (ou moi) qui bug !!!

Bonsoir à tous

Le code de pierrejean fonctionne (bien) si on écrit :

Range("C" & (N + 1)) = Range("A" & liste(N) + 1)

Quant au code de Fo_rum, je doute qu'on puisse le qualifier de tirage aléatoire. En réalisant 100 000 tirages sur les nombres de 1 à 10, on s'attend à trouver environ 10 000 tirages où un nombre donné garde sa place d'origine. Voici le résultat obtenu avec les deux codes :

Voici un autre code qui fonctionne :

Sub tri()
Dim i&, oTmp, oDat(), oPlg As Range
  Set oPlg = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
  If oPlg.Count > 1 And oPlg(1).Row = 2 Then
    oDat = oPlg.Value
    Randomize
    For i = UBound(oDat, 1) To 2 Step -1
      oTmp = oDat(i, 1)
      oDat(i, 1) = oDat(1 + Int(i * Rnd), 1)
      oDat(1 + Int(i * Rnd(0)), 1) = oTmp
    Next i
    oPlg.Offset(0, 6).Value = oDat
  End If
End Sub

ROGER2327
#4825

Mardi 3 Décervelage 138 (Astu, V)
11 Nivôse An CCXIX
2010-W52-5T00:09:31Z

 

[ROGER2327]

Re : tri aleatoire de noms : macro (ou moi) qui bug !!!

Suite…

Je me suis trompé d'image dans le message précédent : je viens de la remplacer.
D'autre part, le code que j'ai proposé fonctionne, mais ne me satisfait pas. En voici un autre :

Sub tri5()
Dim i&, oDat(), oPlg, oColl As New Collection
  Set oPlg = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
  If oPlg(1).Row = 2 And oPlg.Rows.Count > 1 Then
    For i = 1 To oPlg.Rows.Count: oColl.Add oPlg(i): Next
    ReDim oDat(1 To oColl.Count, 1 To 1)
    Randomize
    For i = oColl.Count To 1 Step -1
      oDat(i, 1) = oColl(1 + Int(i * Rnd))
      oColl.Remove 1 + Int(i * Rnd(0))
    Next
    oPlg.Offset(, 6).Value = oDat
  End If
End Sub

​

ROGER2327
#4829

Mercredi 4 Décervelage 138 (Décervelage, SPs)
12 Nivôse An CCXIX
2010-W52-6T21:08:12Z

 

[arvin]

Re : tri aleatoire de noms : macro (ou moi) qui bug !!!

Bonjour , un grand merci pour la réponse, j essai dimanche au taf ,je te tiens au courant

 

[arvin]

Re : tri aleatoire de noms : macro (ou moi) qui bug !!!

Excellent cela fonctionne à merveille
Merci à tous pour vos aides et à bientôt

 

[arvin]

Re : tri aleatoire de noms : macro (ou moi) qui bug !!!

bonjour , je reviens vers toi car la macro fonctionne super bien, mais seulement pour la feuille active : est il possible qu'elle fonctionne pour toutes les feuilles suivantes intitulées : mar., mer., jeu., ven., sam., dim.
voici le code en question
merci beaucoup

Sub melange()
Dim liste As Collection
Set liste = New Collection
nb = Range("A2").End(xlDown).Row - 1
Range("H1") = nb
While liste.Count < nb
Randomize
x = Int((nb * Rnd) + 1)
On Error Resume Next
liste.Add x, CStr(x)
On Error GoTo 0
Wend
For n = 1 To liste.Count
Range("G" & (n + 1)) = Range("A" & (liste(n) + 1))
Next n
End Sub

 

[arvin]

Re : tri aleatoire de noms : macro (ou moi) qui bug !!!

bonjour , en fait j'ai modifié la macro et ça tourne :
Sub melange()

For Each Ws In ActiveWorkbook.Sheets
Ws.Activate

Dim liste As Collection
Set liste = New Collection
nb = Range("A2").End(xlDown).Row - 1
Range("H1") = nb
While liste.Count < nb
Randomize
x = Int((nb * Rnd) + 1)
On Error Resume Next
liste.Add x, CStr(x)
On Error GoTo 0
Wend
For n = 1 To liste.Count
Range("G" & (n + 1)) = Range("A" & (liste(n) + 1))
Next n

Next Ws

 

[arvin]

Re : tri aleatoire de noms : macro (ou moi) qui bug !!!

bonjour , je reviens vers toi car la macro fonctionne parfaitement sauf si il y a 1 seul nom, elle bugge
pourrais tu me corriger cela ?
merci d'avance

Sub melange()
On Error Resume Next
For Each Ws In ActiveWorkbook.Sheets
Ws.Activate

Dim liste As Collection
Set liste = New Collection
nb = Range("A2").End(xlDown).Row - 1
Range("H1") = nb
While liste.Count < nb
Randomize
x = Int((nb * Rnd) + 1)
On Error Resume Next
liste.Add x, CStr(x)
On Error GoTo 0
Wend
For n = 1 To liste.Count
Range("G" & (n + 1)) = Range("A" & (liste(n) + 1))
Next n

Next Ws

Sheets("recap").Select
Range("G1:J11").Select
Selection.Font.ColorIndex = 2
end sub