Mélange aléatoire d'une variable tableau
Bonjour tout le monde!
J'ai une macro qui, entre autres choses, extrait des informations d'un autre classeur. Certaines de ces informations sont placées dans une variable tableau avant d'être réparties sur plusieurs cellule. Jusque là, tout fonctionne parfaitement.
J'aimerais ajouter une fonction pour mélanger les données de la variable tableau avant de l'utiliser mais je n'ai trouvé aucun moyen de le faire. La variable tableau est tableauplaylist.
J'ai donc un tableau contenant un ou plusieurs éléments (et possiblement des doublons qu'il ne faut pas éliminer) et j'aimerais mélanger ces éléments. Je préfère ne pas installer de pack sur Excel pour régler le problème pour que le fichier reste compatible avec une version basique de Excel.
Par exemple, si la variable tableau contient:
A, B, C, D, E
J'aimerais que la macro mélange les éléments de façon aléatoire:
D, E, C, A, B
Est-ce possible de le faire?
Merci d'avance!
Bonjour,
Le code ci-dessous est une adaptation du code de GALOPIN01 de ce post : Tirage aléatoire
Sub TirageAleatoireGalopin01(ByRef TableauPlayList2 As Variant)
Dim Tablo() As Variant, i%, j%, x%, Nb%
Nb = UBound(TableauPlayList2) + 1
ReDim Tablo(1 To Nb)
Randomize
For i = 1 To Nb
Tablo(i) = i
Next
'permutation
For i = Nb To 1 Step -1
x = Int(((i) * Rnd) + 1)
j = Tablo(x)
Tablo(x) = Tablo(i)
Tablo(i) = j
Next
For i = 1 To Nb
Worksheets("Feuil1").Cells(2, Tablo(i)) = TableauPlayList2(i - 1)
Next
End SubSub TestTirageAleatoireGalopin01()
TirageAleatoireGalopin01 Array("A", "B", "C", "D", "E")
End Sub
Bonjour tout le monde,
Une autre proposition très proche (perso), mais où la fonction Melange( ) reçoit une chaîne de 5 caractères en entrée.
Option Explicit
Sub Macro1()
MsgBox Melange("ABCDE")
End Sub
Function Melange(chaine As String) As String
Dim table(5) As Byte, nb As Byte, alea As Byte
Dim doublon As Boolean, i As Byte
Melange = ""
Randomize Timer
Do
Do
doublon = False
alea = Int(Rnd() * 5) + 1
For i = 1 To 5
If table(i) = alea Then
doublon = True
Exit For
End If
Next i
Loop Until doublon = False
nb = nb + 1
table(nb) = alea
Melange = Melange & Mid(chaine, alea, 1)
Loop Until Len(Melange) = 5
End Function
Si la chaîne est de longueur variable, alors utiliser la fonction anagramme( )
Bonjour…
ci-joint, un autre exemple pour mélanger les lignes d’un tableau (doublons acceptés ou pas).
re, une autre méthode simple ( GALOPIN01 court ?)
Sub Mélange()
Dim aA, i, r
With Sheets("Blad1").Range("G11:G20")
aA = .Value
For i = UBound(aA) To 1 Step -1
r = WorksheetFunction.RandBetween(1, i)
x = aA(r, 1)
aA(r, 1) = aA(i, 1)
aA(i, 1) = x
Next
.Offset(, 1).Value = aA
End With
End Sub
Merci pour toutes ces propositions! Mais je me suis entêté hier soir. J'ai fait quelques recherches et j'ai trouvé des solutions. Plutôt que de mélanger le tableau, j'ai décidé d'utiliser directement ses données une par une de façon aléatoire, sachant que le tableau ne sert qu'une fois. Ceci est la portion de mon code qui contient la solution.
NOTE: J'utilise le mot "NUL", car dans mes programmes j'ai interdit que cette variable existe car c'est un nom de fichier interdit par Windows.
For i = 0 To UBound(TableauPlayList)
Do
Randomize
nbAleatoire = Int(0 + Rnd * (j - 0 + 1))
Loop While TableauPlayList(nbAleatoire) = "NUL"
ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column).Value = TableauPlayList(nbAleatoire)
TableauPlayList(nbAleatoire) = "NUL"
Next iMais j'ai aussi trouvé une façon de mélanger un tableau. Mais je ne l'ai pas testé. Il y a peut-être des erreurs.
For i = 0 To UBound(TableauPlayList) 'on compte le nombre de lignes du tableau.
Do
Randomize
nbAleatoire = Int(0 + Rnd * (j - 0 + 1)) 'on choisi un nombre aléatoire dans les limites des lignes du tableau.
Loop While TableauPlayList(nbAleatoire) = "NUL" 'si la valeur choisie est "NUL", cette valeur a déjà été utilisée.
'Alors on boucle pour choisir un autre nombre.
temp00384 = " " & temp00384 & TableauPlayList(nbAleatoire) 'on ajoute la valeur à une chaîne en séparant avec des espaces.
TableauPlayList(nbAleatoire) = "NUL" 'on remplace la valeur du tableau par "NUL" pour ne pas la choisir à nouveau.
Next i
temp00384 = Right(temp00384, Len(temp00384) - 1) 'Pas certain pour cette ligne, il faut enlever le premier caractère de la chaîne qui est un espace.
TableauPlayList = Split(temp00384, " ") 'on transforme la chaîne en tableau pour remplacer l'ancien.bonjour le fil, pour un tableau avec un dimension à utiliser une fois
Sub Mélange()
Dim aA, i, r, s, s1
aA = Array("A", "B", "C", "D", "E")
s = Join(aA) 'joindre le vecteur avant traitement
For i = UBound(aA) To 0 Step -1
r = WorksheetFunction.RandBetween(0, i)
x = aA(r)
aA(r) = aA(i)
aA(i) = x
Next
s1 = Join(aA) 'joindre le vecteur après traitement
MsgBox s & vbLf & s1, vbInformation, "Avant et après Aleo"
End Sub