Code VBA

[MANTALO]

Bonjour, est-il possible de me montrer la forme de code VBA qui permuterait 15 nombres en défilement en ligne 5?
merci
J'ai cherché sur le Forum mais je n'ai pas trouvé exactement ma recherche, notamment au niveau de la vitesse de défilement(optimisation).

 

[job75]

Re : Code VBA

Bonsoir MANTALO,

Voyez le fichier joint et les macros des 2 boutons :

Sub Lancer()
Dim t#
Do
  With [F5:T6] 'à adapter
    .Rows(2) = "=RAND()"
    .Rows(2) = .Rows(2).Value
    .Sort .Rows(2), Orientation:=xlLeftToRight 'tri
  End With
  t = Timer + 0.5 'temporisation 0.5 seconde
  While Timer < t: DoEvents: Wend
Loop
End Sub

Sub Arrêter()
End
End Sub

A+

 

[MANTALO]

Re : Code VBA

Merci Job75

2 NB: Ce code est-il optimisé pour un défilement maximum (j'ai testé avec timer+0)
Est-on sûr que 2 permutations identiques ne surviennent pas (déjà qu'il y en a un certain nombre ou un nombre certain...)

merci et bon Noël

 

[job75]

Re : Code VBA

Re,

1) Avec une temporisation nulle il faut mettre un DoEvents en dehors de la boucle While si l'on veut pouvoir arrêter la macro par le bouton.

2) Bien que très grand le nombre de permutations est limité, donc tôt ou tard on retrouvera des permutations déjà tirées.

A priori il faudra attendre très longtemps...

A+

 

[MANTALO]

Re : Code VBA

Merci je serais curieux de voir le code pour lister une a la suite sans rand?

A+

 

[MANTALO]

Re : Code VBA

Bonjour

J'ai allongé la plage à adapter (F5:AB6) en copiant les cellules (lignes 5 et 6) jusqu'à AB, la macro me sort 4 fois le 13, j'ai des doublons.


merci

 

[job75]

Re : Code VBA

Bonjour MANTALO, le forum,

Une solution avec des tableaux VBA et la macro de tri Quick sort :

Sub Lancer()
Dim a(1 To 15), b(1 To 15), i As Byte, n&
Randomize
'---initialisation---
For i = 1 To 15
  b(i) = i
Next
RAZ
'---tirages---
Do
  For i = 1 To 15
    a(i) = Rnd
  Next
  tri a, b, 1, 15
  [F5:T5] = b
  [F10:T10].Offset(n) = b 'facultatif
  If n = Rows.Count - 9 Then Exit Sub
  n = n + 1
  DoEvents
Loop
End Sub

Sub Arrêter()
End
End Sub

Sub RAZ()
Range("F10:T" & Rows.Count).ClearContents
End Sub

Sub tri(a, b, gauc, droi)        ' Quick sort
Dim ref, g, d, temp
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(d): d = d - 1: Loop
    If g <= d Then
      temp = a(g): a(g) = a(d): a(d) = temp
      temp = b(g): b(g) = b(d): b(d) = temp
      g = g + 1: d = d - 1
    End If
Loop While g <= d
If g < droi Then Call tri(a, b, g, droi)
If gauc < d Then Call tri(a, b, gauc, d)
End Sub

Fichier (2).

A+

 

[MANTALO]

Re : Code VBA

Merci Job75, je pense à une incompréhension tardive ou matinale, ton code est expert ( merci ), mais avec mon alea() et rang(plage) en formules sur 2 lignes de mon tableau, je vais 10 fois plus vite que Quick sort (qui en plus me liste les permutations en lignes pour rien, puisque je souhaite un défilement en ligne5)

Bonne journée et bon Noël.

 

[Modeste geedee]

Re : Code VBA

Bonsour®

lister toutes les permutations ?
factorielle 15, ça risque d'etre trés long (1 307 674 368 000 permutations)

autre proposition :

 

[job75]

Re : Code VBA

Re, hello Modeste geedee,

(qui en plus me liste les permutations en lignes pour rien, puisque je souhaite un défilement en ligne5)

Ben vous listez ou vous ne listez pas, pas de problème.

Mais si vous ne listez pas que faites-vous donc de chaque tirage ?

Vous regardez passer les trains ???

A+

 

[job75]

Re : Code VBA

Re,

Si l'on veut seulement voir passer les trains :

Sub Lancer()
Do: Calculate: DoEvents: Loop
End Sub

Fonctions ALEA() en ligne 6 et RANG en ligne 5.

Fichier (3).

A+

 

[Si...]

Re : Code VBA

salut

Re,
Si... l'on veut seulement voir passer les trains ...
A+

pas pour moi, je viens de découvrir le pourquoi des " vaches folles" : le tortillard a été remplacé par le TGV

 

[job75]

Re : Code VBA

Re, hello Si...

Je pense que MANTALO veut détecter le cas où en ligne 6 la fonction ALEA() donne des doublons.

Donc aussi des doublons en ligne 5.

Alors formule en G2 :

=SOMMEPROD(1/NB.SI(F5:T5;F5:T5))<15

El la macro :

Sub Lancer()
Do
  Calculate
  DoEvents
  If [G2] Then MsgBox "Doublons !": End
Loop
End Sub

Fichier (4).

A+

 

[MANTALO]

Re : Code VBA

merci de vos réponses, ALEA+RANG+CALCULATE est ma méthode, je pensais qu'il y avait plus rapide (dictionary?)

A++

 

[Modeste geedee]

Re : Code VBA

Bonsour®
pour l'instant tu dresses un constat entre une (ta) proposition par formule et diverses propositions VBA (dont la mienne(*) qui mixe les deux méthodes),
cela ne peut etre comparable pusique tu n'historises pas les diverses permutations...
- le méthode dictionary est une méthode VBA qui pourra éventuellement etre comparée à la méthode de JOB75.
- quant à la méthode formule ALEA(), RANG() il ne peut y avoir doublons en ligne 5 ("By design" la fonction ALEA() génére plusieurs millions de nombres différents avant de cycler)

(*) il n'y a aucun doublon sur plus de 65535 tirages (5.011e-8)