XL 2010 Creer tableau avec chiffres aleatoire

chubbaccaa

XLDnaute Nouveau
Bonsoir a tous , je cherche a faire un tableau de 40X40 cases
dans ces 1600 cases , je voudrez y mettre des chiffres compris entre 1 et 1600 , le tout aléatoirement
Jusqu'à maintenant j'arrive a rentré tout ces chiffres aléatoirement mais j'ai des doublons et il ne m'en faut pas
il faut que chaque cases est un chiffre diffèrent

Voila la formule que j'ai écrit dans A1 : =ALEA()*(1-1600)+1600

Je ne trouve as la solution , cela fait plusieurs jours que je cherche mais la , je sèche o_O

Quelqu'un peut il me dire ce qu'il ne va pas
Merci
 

Dranreb

XLDnaute Barbatruc
Bonjour.
En une seule dimension je reste persuadé que le plus simple et le plus rapide, sans boucles imbriquées, c'est :
VB:
Sub InitListeAl(TAl() As Long, Optional ByVal NMax As Long, Optional ByVal Graine As Double)
Rem. ——— Garnit un tableau à une dimension base 1 de numéros sans doublon ou change aléatoirement l'ordre
'        des numéros y étant déjà portés.
'  Arguments :
'     TAl :   Le tableau à traiter.
'     NMax:   Numéro maxi. Si spécifié, le tableau est redimensionné TAl(1 To NMax), puis garni de numéros de 1 à NMax.
'     Graine: Base de départ de la série. Si omis la série sera différente à chaque exécution.
   Dim P As Long, R As Long, X As Long
 
Rem. Initialisation :
   If NMax > 0 Then
      ReDim TAl(1 To NMax): For P = 1 To NMax: TAl(P) = P: Next P
   Else: NMax = UBound(TAl): End If
   If Graine <= 0 Then Randomize Else Rnd -1: Randomize Graine
 
Rem. Mélange de Fisher-Yates :
   For P = NMax To 2 Step -1
      R = Int(Rnd * P) + 1: X = TAl(R): TAl(R) = TAl(P): TAl(P) = X
      Next P
   End Sub
 
Dernière édition:

sylvanu

XLDnaute Barbatruc
Supporter XLD
Re bonjour Mapomme,
Sur mon PC, si tu ajoutes un Application.ScreenUpdating = False à ton code alors l'exécution est encore plus rapide.
Exact ... et absurde. je n'y aurais pas pensé, c'est contre nature.
Sauf si ça joue lors de la restitution de la matrice.
J'utilise Dim T(1 to 40 ,1 to 40) par exemple.
Encore exact. Je pensé être plus rapide à l'exécution. Ce qui est faux après mesure.
Donc autant rester le plus souple possible.
 

Dranreb

XLDnaute Barbatruc
C'est rien du tout de verser les nombres aléatoires d'un tableau à une dimension dans une matrice carrée. Ma fonction ListeAl le fait bien dans la feuille "Fonction ListeAl" de mon ListeAléat.xlsm du #3 si on entre "40*40" en P8 nommé "DimPlgMat" et je pense que ça reste plus rapide de faire comme ça que d'adapter l'algorithme Fisher-Yates pour un tableau 2D.
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour @Dranreb et mes meilleurs vœux pour la nouvelle année ;).

je pense que ça reste plus rapide de faire comme ça que d'adapter l'algorithme Fisher-Yates pour un tableau 2D.
C'est rigolo, je mélangeais par ma méthode depuis des années sans savoir que quelqu'un avait donné son nom à cette méthode.

Nous en sommes à quelque dixièmes de seconde pour l'exécution dans sa totalité.
Si ce n'est l’organisation interne des tableaux unidimensionnels ou multidimentionnels des arrays (que je ne connais pas en VBA), je pense que la différence de temps d'exécution entre le mélange des deux types d'array est epsilonesque. A mon humble avis, l'adressage au niveau des arrays est un adressage direct en fonction des indices et il y a peu de différence d'accès quelques soient les dimensions de l'array.
Mais je me trompe peut-être 🤔 et je suis prêt à le reconnaitre.
 

Dranreb

XLDnaute Barbatruc
Non, c'est vrai, il y a peu de différence de durée d'accès à un tableau selon le nombre de dimensions. Mais il resterait à calculer les 2 indices dépendant d'un Rnd pour appliquer le mélange de Fisher-Yates. Ce serait donc un tout petit peu plus compliqué.
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonsoir,
Si on compare les deux algos sur l'exemple donné :
- Matrice 1600*1 : 1600 RND à calculer, mais construction de la matrice 40*40 avant transfert.
- Matrice 40*40 : 3200 RND à calculer mais transfert direct de la matrice.
Alors j'ai fait un test comparatif. Pour éviter les fluctuation temporelles des mesures j'ai fait le test sur 10000 runs sur mon PC (Win10 XL2007).
Et la sentence est tombée.

Désolé, Monsieur Dranreb vous êtes largué.

La solution 40*40 prend en moyenne 5221µs alors que la solution 1600*1 prend 5546µs. Soit 6% de moins.
Mais comme Mapomme et moi sommes bons princes et qu'on est fairplay sur XLD, on va dire, par abus de langage, que c'est "presque" équivalent.
😅😂🤣😂😅😂🤣
NB: Plus sérieusement la seule différence est que la solution 1600*1 prend deux arrays 1600*1 et 40*40, alors que la solution 40*40 n'en prend qu'un.
Mais comme il arrive à Job de compter les octets, ça fait une sacré différence. :)
 

Dranreb

XLDnaute Barbatruc
Bon je l'ai fait :
VB:
Option Explicit
Sub Test()
   Dim TTest() As Long
   ReDim TTest(1 To 10, 1 To 10)
   InitListeAl2D TTest
   [B2].Resize(10, 10).Value = TTest
   End Sub
Sub InitListeAl2D(TAl() As Long, Optional ByVal Graine As Double, Optional ByVal Init As Boolean = True)
Rem. ——— Garnit un tableau à 2 dimensions base 1 de numéros sans doublon ou change aléatoirement l'ordre
'        des numéros y étant déjà portés.
'  Arguments :
'     TAl :   Le tableau à traiter. Doit être dimensionné.
'     Graine: Base de départ de la série. Si omis la série sera différente à chaque exécution.
'     Init: Si spécifié False le contenuu initial du tableau est conservé, seulement mélangé.
   Dim L1 As Long, C1 As Long, L2 As Long, C2 As Long, P As Long, Q As Long, X As Long
 
Rem. Initialisation :
   If Init Then
      For L1 = 1 To UBound(TAl, 1): For C1 = 1 To UBound(TAl, 2)
         X = X + 1: TAl(L1, C1) = X: Next C1, L1
      End If
   If Graine <= 0 Then Randomize Else Rnd -1: Randomize Graine
 
Rem. Mélange de Fisher-Yates :
   For P = UBound(TAl, 1) * UBound(TAl, 2) To 2 Step -1
      L2 = (P - 1) \ UBound(TAl, 2) + 1: C2 = (P - 1) Mod UBound(TAl, 2) + 1
      Q = Int(Rnd * P) + 1
      L1 = (Q - 1) \ UBound(TAl, 2) + 1: C1 = (Q - 1) Mod UBound(TAl, 2) + 1
      X = TAl(L1, C1): TAl(L1, C1) = TAl(L2, C2): TAl(L2, C2) = X
      Next P
   End Sub
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Du coup seriez vous interessé par une Sub InitListeAl2D ?
En fait ce ne serait guère utile.
J'ai fait un moyennage sur 10k samples juste pour comprendre et en avoir le cœur net. Un simple exercice intellectuel.
Mais si on regarde run par run comme dans une appli "normale" la différence est "espilonesque"( autour de 200µs sur mon PC ). Un ex sur 100 runs ci dessous, même si la moyenne montre un écart de 230µs, point à point on peut avoir l'un devant l'autre ou l'inverse, cela dépend du contexte Windows à ce moment.
1674234761751.png
 

patricktoulon

XLDnaute Barbatruc
Bonsoir à tous
chez moi 0.039 sec

VB:
Sub test()
Dim dico, t#, x&, plage As Range
Randomize
Set dico = CreateObject("scripting.dictionary")
Set plage = [A1].Resize(40, 40)
t = Timer
Do While x < (40 * 40)
num = Round(1 + (Rnd * 1599))
If Not dico.exists(num) Then
x = x + 1
plage.Cells(x) = num
dico(num) = plage.Cells(x)
End If
Loop
MsgBox Format(Timer - t, "#0.000 sec")
End Sub
1674236665667.png
 

patricktoulon

XLDnaute Barbatruc
re
et celui là 0.016 sec
même principe finalement ;je rempli un tableau 2 dim avec une seul boucle avec (le dico)
VB:
Sub test2()
Dim dico, t#, x&, plage As Range, tb()
Randomize
Set dico = CreateObject("scripting.dictionary")
Set plage = [A1].Resize(40, 40)
ReDim tb(1 To 40, 1 To 40)
t = Timer
l = 1: col = 1
Do Until x = (40 * 40)
  num = Round(1 + (Rnd * 1599))
  If Not dico.exists(num) Then
   x = x + 1
    dico(num) = num
   tb(l, col) = num
   col = col + 1
   If col = 40 And l < 40 Then col = 1: l = l + 1
   If l = 40 And col = 40 Then Exit Do
  End If
Loop
plage.Value = tb
MsgBox Format(Timer - t, "#0.000 sec")
End Sub
 

Discussions similaires

Membres actuellement en ligne

Aucun membre en ligne actuellement.

Statistiques des forums

Discussions
312 177
Messages
2 085 972
Membres
103 073
dernier inscrit
MSCHOE16