Autres Une p'tite MACRO VBA

OlivGM · 27 Novembre 2023

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 · 27 Novembre 2023

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

Dranreb · 27 Novembre 2023

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

patricktoulon · 27 Novembre 2023

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

VB:

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 · 27 Novembre 2023

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

patricktoulon · 27 Novembre 2023

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

VB:

#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 · 27 Novembre 2023

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 · 27 Novembre 2023

patricktoulon à dit:
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 · 27 Novembre 2023

Bonjour @patricktoulon 😉 ,

patricktoulon à dit:
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 · 28 Novembre 2023

patricktoulon à dit:
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 · 28 Novembre 2023

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 · 28 Novembre 2023

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

patricktoulon · 28 Novembre 2023

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 · 28 Novembre 2023

Dranreb à dit:
Ç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]

VB:

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 · 28 Novembre 2023

Modeste geedee à dit:
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 · 28 Novembre 2023

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

Autres Une p'tite MACRO VBA

OlivGM

XLDnaute Occasionnel

Pièces jointes

OlivGM

XLDnaute Occasionnel

Dranreb

XLDnaute Barbatruc

Pièces jointes

patricktoulon

XLDnaute Barbatruc

Dranreb

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

Pièces jointes

Dranreb

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Modeste geedee

XLDnaute Barbatruc

Dranreb

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Discussions similaires

Autres Une p'tite MACRO VBA

XLDnaute Occasionnel

Pièces jointes

XLDnaute Occasionnel

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

Discussions similaires

Privacy & Transparency

Privacy & Transparency