randomiser

manulemalin13000 · 30 Août 2010

Bonjour,
Je souhaite randomiser une liste excel mais il y a 2 conditions:
- La liste doit etre randomisée mais en liant les cellules qui ont une meme valeur dans la colonne A

- Au sein des lignes ayant meme valeur en colonne A il serait ideal que ce soit aussi randomisé a l interieur d une meme valeur

Exemple fournit de ce que j ai et ce que je souhaite dans deux onglets.

Quelqu un sait faire cela ?

Merci
Manu

hoerwind · 30 Août 2010

Re : randomiser

Bonjour,

Peux-tu expliquer ce que tu entends par "randomiser", ou bien en donner la traduction en français ?

Si tu avais précisé les critères, probablement que je n'aurais pas du te poser cette question.

manulemalin13000 · 31 Août 2010

Re : randomiser

Bonjour,

Randomiser veut dire classer au hasard.
Cela vient de l'anglais "random" = au hasard

En gros j'ai des chiffres dans cette feuille excel
Je souhaite les melanger au hasard

merci

manu

hoerwind · 31 Août 2010

Re : randomiser

Bonjour,

Donc si j'ai compris :

Recopier de façon aléatoire les lignes du premier tableau dans le second, tout en recopiant aléatoirement les valeurs ligne par ligne.
Je suppose aussi qu'une fois la copie effectuée, elle doit restée figée (ne pas de réactualiser à chaque calcul du fichier).

Tu ne précises pas si tu souhaites une solution par formule ou VBA.
Il me semble que cette dernière solution serait la meilleure, mais là je ne puis t'aider.

manulemalin13000 · 31 Août 2010

Re : randomiser

Re,

Je souhaite recopier les lignes de facon aleatoire mais tout en gardant LIEES les lignes qui ont le meme nombre en colonne A

Et, pour deux ou trois lignes qui ont le meme nombre en colonne A cela doit etre lié mais classé au hasard.

En resumé :

Classer au hasard par groupes de valeurs de colonne A

Et mettre au hasard a l'interieur d un groupe ayant meme valeur en A.

Je pense que le VBA s impose pour ce genre de calcul

Merci

pierrejean · 31 Août 2010

Re : randomiser

Bonjour a tous

Une premiere approche (les groupes sont recopiés de façon aleatoire)
Dans un deuxieme temps j'etudie la façon de rendre aleatoire la recopie des lignes dans chaque groupe

manulemalin13000 · 31 Août 2010

Re : randomiser

Merci Pierrejean,

C'est deja pas mal du tout...

pierrejean · 31 Août 2010

Re : randomiser

Re

Voici la suite (A tester)
Et merci a mon amie Laetitia pour l'initiation a Dictionary ( Que je connaissais par mon ami le Grand Hervé ,mais a l'epoque je n'avais pas encore la maturité suffisante pour en entreprendre l'etude)

manulemalin13000 · 31 Août 2010

Re : randomiser

Cher Pierrejean,

Merci c'est tout simplement parfait..

Merci a vous tous (ainsi qu'a Elodie...)

C'était pour une bonne cause...la sclérose en plaques

Manu

ROGER2327 · 31 Août 2010

Re : randomiser

Bonjour à tous

En retard...
Mais puisque je l'ai fait, je livre...

Code:

[COLOR="DarkSlateGray"][B]Sub toto()
Dim i&, j&, l&, c&, n&, oDat, oColl1 As New Collection, oColl2 As New Collection
Dim a&, ra&, b&, rb&, par(1 To 3)
   With Application
      par(1) = .EnableEvents: par(2) = .CalculationState: par(3) = .ScreenUpdating
      .ScreenUpdating = False: .Calculation = xlCalculationManual: .EnableEvents = False
   End With
   [COLOR="Red"]Randomize[/COLOR]
   With Sheets("Ce que j'ai")
      l = .Cells(.Rows.Count, 1).End(xlUp).Row
      c = .Cells(1, .Columns.Count).End(xlToLeft).Column
      oDat = .Range(.Cells(1, 1), .Cells(l, c)).Value
      On Error Resume Next
      For i = 2 To l
         oColl1.Add Item:=i, Key:=CStr(oDat(i, 1))
      Next i
      On Error GoTo 0
      n = 1
      .Cells(1, 1).Resize(1, c).Copy Destination:=Sheets("Ce que je veux obtenir").Cells(n, 1)
      For i = oColl1.Count To 1 Step -1
         a = Int(Rnd() * i) + 1
         ra = oColl1(a)
         oColl1.Remove a
         Set oColl2 = Nothing
         For j = 2 To l
            If oDat(j, 1) = oDat(ra, 1) Then oColl2.Add Item:=j
         Next j
         For j = oColl2.Count To 1 Step -1
            b = Int(Rnd() * j) + 1
            rb = oColl2(b)
            oColl2.Remove b
            n = n + 1
            .Cells(rb, 1).Resize(1, c).Copy
            With Sheets("Ce que je veux obtenir").Cells(n, 1)
               .PasteSpecial Paste:=xlPasteFormats
               .PasteSpecial Paste:=xlPasteValues
            End With
         Next j
      Next i
   End With
   With Application
      .EnableEvents = par(1): .Calculation = par(2): .ScreenUpdating = par(3)
   End With
End Sub[/B][/COLOR]

ROGER2327
#4032

Samedi 21 Phalle 137 (Erbrand, polytechnicien, ST)
14 Fructidor An CCXVIII
2010-W35-2T14:35:18Z

manulemalin13000 · 31 Août 2010

Re : randomiser

Merci Roger2327,

juste pour info à PierreJean, quand ma liste s allonge en colonnes et en lignes, le resultat que j obtient à l arrivée me fait perdre des echantillons..
J'avais mis peu d'echantillons car le fichier pesait trop lourd pour l'upload
Je pars avec 410 echantillons, j'arrive avec 406 !!
J ai modifié la macro en remplacant

Range("A1:Y1").Copy par Range("A1:IV1").Copy

et

Range("A1:Y1").Copy par Range("A1:IV1").Copy

Cela dit un grand merci a vous deux pour l'aide.
Manu

pierrejean · 31 Août 2010

Re : randomiser

Re

Code modifié pour un nombre quelconque de colonnes
Par ailleurs j'ai testé et retesté avec 410 lignes et pas de pertes !
Neanmoins il est plus prudent d'adopter le code de ROGER (que je salue)
Il est d'ailleurs plus rapide que le mien

Code:

Sub random2()
debut = Timer
Application.ScreenUpdating = False
Sheets("Res").Cells.Clear
Range("A1:IV1").Copy
Sheets("Res").Cells(1, 1).PasteSpecial Paste:=xlPasteValues
Sheets("Res").Cells(1, 1).PasteSpecial Paste:=xlPasteFormats
tablo = Range("A2:A" & Range("A65536").End(xlUp).Row)
Dim t2()
ReDim t2(1 To 2, 0)
Set d = CreateObject("Scripting.Dictionary")
For n = LBound(tablo, 1) To UBound(tablo, 1)
 If Not d.exists(tablo(n, 1)) Then
   d(tablo(n, 1)) = 1
   t2(1, UBound(t2, 2)) = tablo(n, 1)
   t2(2, UBound(t2, 2)) = n + 1
   ReDim Preserve t2(1 To 2, UBound(t2, 2) + 1)
 Else
   For m = LBound(t2, 2) To UBound(t2, 2) - 1
     If t2(1, m) = tablo(n, 1) Then
        t2(2, m) = t2(2, m) & "-" & n + 1
     End If
   Next m
 End If
Next n
Set f = CreateObject("Scripting.Dictionary")
While f.Count < UBound(t2, 2) + 1
  Randomize
  w = Int((UBound(t2, 2) + 1) * Rnd)
  f(w) = 1
Wend
ww = f.keys
For s = LBound(ww) To UBound(ww)
  suite = suite & melange(t2(2, ww(s)))
Next s
suite = Left(suite, Len(suite) - 1)
ligne = 2
zz = Split(suite, "-")
For n = LBound(zz) To UBound(zz)
  Range("A" & zz(n) & ":IV" & zz(n)).Copy
  Sheets("Res").Cells(ligne, 1).PasteSpecial Paste:=xlPasteValues
  Sheets("Res").Cells(ligne, 1).PasteSpecial Paste:=xlPasteFormats
  ligne = ligne + 1
Next n
Application.CutCopyMode = False
Application.ScreenUpdating = True
Sheets("Res").Select
ActiveWindow.Zoom = 25
MsgBox (Timer - debut)
End Sub
Function melange(liste)
x = Split(liste, "-")
Set e = CreateObject("Scripting.Dictionary")
While e.Count < UBound(x) + 1
  Randomize
  Z = Int((UBound(x) + 1) * Rnd)
  e(Z) = 1
Wend
t3 = e.keys
For n = LBound(t3) To UBound(t3)
  melange = x(t3(n)) & "-" & melange
Next n
End Function

Ps: @ ROGER : Pas de Randomize ?

ROGER2327 · 31 Août 2010

Re : randomiser

Re...
Bonjour pierrejean

pierrejean à dit:
(...)
Ps: @ ROGER : Pas de Randomize ?

C'est un oubli : il vaut mieux l'ajouter en début de procédure...

Cordialement,
ROGER2327
#4033

Samedi 21 Phalle 137 (Erbrand, polytechnicien, ST)
14 Fructidor An CCXVIII
2010-W35-2T15:45:18Z

_________________
P.s. : Message #10 corrigé pour tenir compte de votre judicieuse remarque...

manulemalin13000 · 1 Septembre 2010

Re : randomiser

Bonjour,
Merci a vous deux pour votre aide
Bonne continuation

randomiser

manulemalin13000

XLDnaute Occasionnel

Pièces jointes

hoerwind

XLDnaute Barbatruc

manulemalin13000

XLDnaute Occasionnel

hoerwind

XLDnaute Barbatruc

manulemalin13000

XLDnaute Occasionnel

pierrejean

XLDnaute Barbatruc

Pièces jointes

manulemalin13000

XLDnaute Occasionnel

pierrejean

XLDnaute Barbatruc

Pièces jointes

manulemalin13000

XLDnaute Occasionnel

ROGER2327

XLDnaute Barbatruc

Pièces jointes

manulemalin13000

XLDnaute Occasionnel

pierrejean

XLDnaute Barbatruc

ROGER2327

XLDnaute Barbatruc

manulemalin13000

XLDnaute Occasionnel

Discussions similaires

randomiser

XLDnaute Occasionnel

Pièces jointes

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

Pièces jointes

XLDnaute Occasionnel

XLDnaute Barbatruc

Pièces jointes

XLDnaute Occasionnel

XLDnaute Barbatruc

Pièces jointes

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Occasionnel

Discussions similaires

Privacy & Transparency

Privacy & Transparency