Macro pour mélanger des cellules

Bonsoir à tous,

En colonne A, j'ai une dizaine de cellule avec des valeurs que je souhaiterais mélanger de façon aléatoire en appuyant sur un bouton.

Je connais la manipulation qui consiste à mettre en colonne B un nombre aléatoire avec Alea en face de chaque valeur à mélanger, puis de faire un tri sur la colonne B. Cela fonctionne mais je souhaiterais aller plus vite car j'ai un nombre important de mélange à effectuer à la suite.

De plus je suis sous Mac, donc pas de Active X...

Merci d'avance pour votre aide!

Bonne soirée

Jérôme

Bonjour Jérôme,

Voici un exemple,

Sub test()
Dim Dic As Object, x As Long, n As Long
Dim Limite_Inf As Long, LimiteSup As Long
Dim Nb As Long

Nb = 10   'Nombre de valeurs différentes à tirer
Limite_Inf = 1: LimiteSup = Nb

Set Dic = CreateObject("Scripting.dictionary")

While Dic.Count < Nb
   Randomize
   x = Application.RandBetween(Limite_Inf, LimiteSup)
   If Not Dic.exists(x) Then
       n = n + 1
       DoEvents
       Dic.Add x, n
   End If
Dic(x) = x
Wend

With Worksheets("Feuil1") 'Nom feuille à adapter
   'Pour écrire en colonne le résultat
   .Range("A1").Resize(Nb) = Application.Transpose(Dic.keys)

   'Pour écrire en ligne le résultat
'   .Range("A1").Resize(, Nb) = Dic.keys
End With
End Sub

Bonjour,

@ i20100

L'objet Dictionary n'est pas disponiblet sous Mac.

Cdlt.

Bonjour,

Merci beaucoup pour la réponse, mais effectivement, ça ne marche pas sous Mac

Bonne journée

Saluuuut,

Bonjour Jean-Eric!

Bonjour i20100!

Un autre code à tester :

Sub a()
Dim x, y, z As Long
Dim cell1, cell2 As String
For x = 1 To Range("A" & Rows.Count).End(xlUp).Row
    z = Int(Range("A" & Rows.Count).End(xlUp).Row * Rnd) + 1
    cell1 = Cells(z, 1)
    y = Int(Range("A" & Rows.Count).End(xlUp).Row * Rnd) + 1
    cell2 = Cells(y, 1)
    Cells(y, 1) = cell1
    Cells(z, 1) = cell2
Next
End Sub

A voir si sa marche ou non sur MAC après :p

Restant à dispo!

Re,

Super ça marche!!

Merci beaucoup!!

Bien cordialement

Jérôme

Rechercher des sujets similaires à "macro melanger"