Autres Une p'tite MACRO VBA

[OlivGM]

Bonjour et bon lundi,

Je souhaiterais la création d'un code pour remplir un rectangle de nombres (sans doublon et sans classement ).
J'ai essayé avec "Alea entre bornes" mais ce fut un véritable échec. J'ai excel 2007 chez moi pour info.
Ce qui m'importe surtout est la vitesse d'exécution du code VBA.
Le code le plus rapide sera donc l'élu! (un chrono serait bien à ajouter pour savoir le temps d'affichage des 80 nombres simultanés)!!

MERCI
O.

ps: s'il y a trop d'écart de temps entre la production de 10 et 8 lignes de nombres, je me contenterai de 8 lignes (64 nombres).

 

[OlivGM]

Merci beaucoup de votre aide.
J'ai le choix !

 

[Dranreb]

J'ai ajouté le chrono. C'est moins de 20 millisecondes pour moi.

 

[patricktoulon]

re
et moi même en metant 8 decimales je ne vois que des zeros les gars
et j'arrête le compteur après l'injection dans la plage en plus

Sub test()
    Dim I&, C&, X&, col&, Lig&, tbl(), tim#

    Randomize
    tim = Timer
    ReDim Preserve tbl(1 To 10, 1 To 70)
    For C = 1 To 70: For I = 1 To 10: tbl(I, C) = C: Next: Next


    For I = 1 To 10
        For C = 1 To 8
            col = Int(1 + (Rnd * 70))
            tmp = tbl(I, C): tbl(I, C) = tbl(I, col): tbl(I, col) = tmp
        Next
    Next
    [u6].Resize(10, 8) = tbl
    MsgBox Format(Timer - tim, "#0.00000000")
End Sub

allez bonne nuit

 

[Dranreb]

Oui, avec cet ordre de grandeur de durées il faut absolument prendre QueryPerformanceCounter pour pouvoir les mesurer.

 

[patricktoulon]

de toute facon je reste convaincu
que le plus rapide reste le melange au hasard et non la pioche au hasard

et tu peux faire des tests sur des gros arrays

melange et pioche c'est pas la même chose
1°on a qu'une seule variable tableau
2° les fonctions rnd ne sont jamais remis en question en cas de doublons (car on s'en fou)

4° j'ai testé avec QueryPerformanceCounter je suis toujours à zero

#If VBA7 Then
    Private Declare PtrSafe Function QueryPerformanceFrequency Lib "kernel32" (X As Currency) As Boolean
    Private Declare PtrSafe Function QueryPerformanceCounter Lib "kernel32" (X As Currency) As Boolean
#Else
    Private Declare Function QueryPerformanceFrequency Lib "kernel32" (X As Currency) As Boolean
    Private Declare Function QueryPerformanceCounter Lib "kernel32" (X As Currency) As Boolean
#End If
Private PCtrLancmt As Currency
Public TempsSecondes As Double
Sub LancerChrono()
    QueryPerformanceCounter PCtrLancmt
End Sub
Function StopChrono() As Double
    Dim PCtrActuel As Currency, Freq As Currency
    QueryPerformanceCounter PCtrActuel
    QueryPerformanceFrequency Freq
    TempsSecondes = (PCtrActuel - PCtrLancmt) / Freq
End Function


Sub test()
    Dim I&, C&, X&, col&, Lig&, tbl(), tmp

    Randomize
    LancerChrono
    ReDim Preserve tbl(1 To 10, 1 To 70)
    For C = 1 To 70: For I = 1 To 10: tbl(I, C) = C: Next: Next


    For I = 1 To 10
        For C = 1 To 8
            col = Int(1 + (Rnd * 70))
            tmp = tbl(I, C): tbl(I, C) = tbl(I, col): tbl(I, col) = tmp
        Next
    Next
    StopChrono
    [u6].Resize(10, 8) = tbl
    MsgBox Format(TempsSecondes, "#0.0000")
End Sub

et si vous cherchez bien le mois dernier un sujet similaire j'ai fait la même chose sans préremplir le tableau donc la boucle de remplissage en moins

 

[mapomme]

Re,

Avec le module de chronométrage de @Dranreb que je salue et que j'ai pompé (je parle du module !), ma macro fait le travail en moins de 2,5 ms en fonction du tri ou non des lignes (sur ma bécane bien sûr).

Avec la macro de @Dranreb, c'est kif kif bourricot.

nota : le tri que j'ai utilisé est le tri basique par bulle parce que le nombre d’éléments à trier (x8) est très faible.

 

[Dranreb]

j'ai testé avec QueryPerformanceCounter je suis toujours à zero

Ça ce n'est pas possible: Un LancerChrono immédiatement suivi d'un StopChrono laisse déjà une durée entre 0,0012 et 0,0045 millisecondes, soit plus d'une microseconde.

 

[mapomme]

Bonjour @patricktoulon ,

bonjour @mapomme
pourquoi charger 2 tableaux ???
c'est inutile

C'est une réminiscence de jeunesse quand la mémoire était précieuse et dont j'ai du mal à me débarrasser.
J'ai débuté avec un Amstrad CPC 464 (64 k de mémoire RAM) donc on économisait la mémoire au maximum.

• La macro de ma pomme utilise un tableau de 80 éléments et un autre de 70 soit 150 éléments.
• La macro de ta pomme utilise un tableau de 700 éléments.

C'est tout. Il ne faut pas chercher plus loin...

 

[mapomme]

4° j'ai testé avec QueryPerformanceCounter je suis toujours à zero

Pour le temps en ms, utilise donc : MsgBox Format(TempsSecondes * 1000#, "#0.000\ ms")

 

[patricktoulon]

re

• La macro de ma pomme utilise un tableau de 80 éléments et un autre de 70 soit 150 éléments.
• La macro de ta pomme utilise un tableau de 700 éléments.

heu..non la macro de ma banane , utilise un tableau de 70 et un tableau de 80 c'est tout
edit :à oui dans la version 2

 

[patricktoulon]

@Dranreb
chez moi c'est bien plus bas q'une miliseconde

 

[patricktoulon]

re
verrsion mapomme

version patosh

1°r patricktoulon on est dans les nano seconde
2°@ mapomme on est aussi dans les nano secondes
3°@dranreb dans les milisecondes

@OlivGM qui voulait du rapide ben là il est servi

 

[Modeste geedee]

Ça ce n'est pas possible: Un LancerChrono immédiatement suivi d'un StopChrono laisse déjà une durée entre 0,0012 et 0,0045 millisecondes, soit plus d'une microseconde.

Bonsour®

[mode mouche du coche]
pourquoi ne pas utiliser simplement l'API GetTickCount ?

la réponse est en millisecondes
et correspond à un temps windows rafraichissement affichage compris
[/mode mouche du coche]

Private Declare Function GetTickCount Lib "kernel32" () As Long

Sub testtoulon()
    Dim I&, C&, X&, col&, Lig&, tbl(), tmp
    Randomize
    deb = GetTickCount
    ReDim Preserve tbl(1 To 10, 1 To 70)
    For C = 1 To 70: For I = 1 To 10: tbl(I, C) = C: Next: Next
    For I = 1 To 10
        For C = 1 To 8
            col = Int(1 + (Rnd * 70))
            tmp = tbl(I, C): tbl(I, C) = tbl(I, col): tbl(I, col) = tmp
        Next
    Next    
    [u6].Resize(10, 8) = tbl
  
   MsgBox GetTickCount - deb & " millisec"
  
End Sub

 

[Dranreb]

pourquoi ne pas utiliser simplement l'API GetTickCount ?

Parce que le rafraichissement de sa valeur n'est pas aussi fréquent que celui du compteur renvoyé par QueryPerformanceCounter.
En fait la valeur rendue par GetTickCount ne change que toutes les 15 millisecondes, tout comme VBA.Timer.

 

[patricktoulon]

re
Bonjour @Modeste geedee
chez moi ton code donne 16 millisec
mais je suis perplexe car avec un timer je n'ai pas un chiffre au dessus de zero avant la 5 ème decimale