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

phlaurent55

Nous a quittés en 2020

Repose en paix

• 30 Décembre 2010

• #2

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

Cliquez pour agrandir...

à+
Philippe

 

Pièces jointes

• 111.xls

  16.5 KB · Affichages: 154
• 111.xls

  16.5 KB · Affichages: 162
• 111.xls

  16.5 KB · Affichages: 160

Vote positif 0 Vote négatif

A

arvin

XLDnaute Occasionnel

• 30 Décembre 2010

• #3

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

 

Vote positif 0 Vote négatif

F

Fo_rum

XLDnaute Accro

• 30 Décembre 2010

• #4

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

bonsoir

un autre exemple parmi tant d'autres

Code:

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

 

Vote positif 0 Vote négatif

A

arvin

XLDnaute Occasionnel

• 30 Décembre 2010

• #5

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 !

 

Vote positif 0 Vote négatif

ROGER2327

XLDnaute Barbatruc

• 31 Décembre 2010

• #6

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

Bonsoir à tous

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

Code:

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 :

VB:

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

 

Pièces jointes

• screenshot.11.jpg

  43.5 KB · Affichages: 108

Dernière édition: 1 Janvier 2011

Vote positif 0 Vote négatif

ROGER2327

XLDnaute Barbatruc

• 1 Janvier 2011

• #7

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 :

VB:

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

 

Vote positif 0 Vote négatif

A

arvin

XLDnaute Occasionnel

• 1 Janvier 2011

• #8

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

 

Vote positif 0 Vote négatif

A

arvin

XLDnaute Occasionnel

• 2 Janvier 2011

• #9

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

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

 

Vote positif 0 Vote négatif

A

arvin

XLDnaute Occasionnel

• 24 Janvier 2011

• #10

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

 

Vote positif 0 Vote négatif

A

arvin

XLDnaute Occasionnel

• 25 Janvier 2011

• #11

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

 

Vote positif 0 Vote négatif

A

arvin

XLDnaute Occasionnel

• 1 Avril 2011

• #12

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

 

Vote positif 0 Vote négatif