tempo di esecuzione di una macro.

[mflautoPartecipante mflauto Karma: 1 pt]

Buongiorno a tutti,

c'è qualcuno che puoi indicarmi  una routine per calcolare il tempo che una macro impiega a svolgere un set di istruzioni?

Grazie come sempre.

Max

 

[Luca73Partecipante Luca73 Karma: 58 pts]

Ciao

La cosa più semplice è inserire in una variablile l'orario all'inizio della macro e poi far calcolare la differenza tra l'orario alla fine della macro e il valore archiviato nella variabile qualcosa del tipo:

Sub CalcolaTempo()
Dim TempoINI
Dim TempoFin
Dim Indice

TempoINI = Time()
For Indice = 1 To 2

    Application.Wait (Now + TimeValue("0:00:01") * 1.5)
Next Indice
TempoFin = Time()

MsgBox "la durata della macro è stata di :" & (TempoFin - TempoINI) * 60 * 60 * 24
End Sub

[mflautoPartecipante mflauto Karma: 1 pt]

Buongiorno Luca,

grazie per la tua disponibilità.

ho inserto la macro all'inizio e alla fine delle mie istruzioni è corretto?

Sub PULISCI_FOGLI()

Application.ScreenUpdating = False

On Error Resume Next

Worksheets("START").Activate

Dim TempoINI
Dim TempoFin
Dim Indice

If MsgBox("Sei Sicuro di Eliminare Tutti i Dati dai Fogli Formattati?", vbYesNo) = vbNo Then
Exit Sub
End If

TempoINI = Time()
For Indice = 1 To 2
 Application.Wait (Now + TimeValue("0:00:01") * 1.5)
Next Indice

Worksheets("ESTRAZIONE ANTHEA").Select ' attiva il foglio "ESTRAZIONE ANTHEA"
Range("A1:H1").Select ' SELEZIONA LE CELLE : A1:L1
Selection.AutoFilter  ' TOGLIE IL FILTRO
Worksheets("ESTRAZIONE ANTHEA").Range("A1:ZZ10000").ClearContents 'elimina tutti i dati dsl foglio ESTRAZIONE ANTHEA
Worksheets("ESTRAZIONE ANTHEA").Range("A1:ZZ10000").ClearContents 'elimina tutti i dati dsl foglio ESTRAZIONE ANTHEA
Worksheets("ESTRAZIONE ANTHEA").Range("A2:ZZ10000").ClearFormats 'elimina tutti i dati dsl foglio ESTRAZIONE ANTHEA

Worksheets("DATI_PORTALE").Select ' attiva il foglio DATI_PORTALE
Worksheets("DATI_PORTALE").Range("A1:ZZ10000").ClearContents 'elimina tutti i dati dsl foglio DATI_PORTALE
Worksheets("DATI_PORTALE").Range("A1:ZZ10000").ClearContents 'elimina tutti i dati dsl foglio DATI_PORTALE
Worksheets("DATI_PORTALE").Range("A2:ZZ10000").ClearFormats 'elimina tutti i dati dsl foglio DATI_PORTALE
   
Worksheets("FIR5%").Select ' SELEZIONA il foglio "FIR5%""
Worksheets("FIR5%").Range("A4:H10000").ClearContents 'elimina tutti i dati dsl foglio "FIR5%"

Worksheets("CONTI").Select ' SELEZIONA il foglio "CONTI"
Range("A1:L1").Select ' SELEZIONA LE CELLE : A1:L1
Selection.AutoFilter  ' TOGLIE IL FILTRO
Worksheets("CONTI").Range("A2:M10000").ClearContents 'elimina tutti i dati dsl foglio  "CONTI"
Worksheets("CONTI").Range("A2:Z10000").ClearContents 'elimina tutti i dati dsl foglio  "CONTI"

Worksheets("SACCONI").Select ' SELEZIONA il foglio "SACCONI"
Range("A1:H1").Select
Selection.AutoFilter 'toglie il filtro dati
Worksheets("SACCONI").Range("A1:ZZ10000").ClearContents 'elimina tutti i dati dsl foglio  "SACCONI"
Worksheets("SACCONI").Range("A1:ZZ10000").ClearContents 'elimina tutti i dati dsl foglio  "SACCONI"
Worksheets("SACCONI").Range("A1:ZZ10000").ClearFormats  'elimina la formattazione dal foglio   "SACCONI"

Worksheets("MULTISEZIONI").Select ' SELEZIONA il foglio "MULTISEZIONI"
Range("A1:H1").Select
Selection.AutoFilter 'toglie il filtro dati
Worksheets("MULTISEZIONI").Range("A1:ZZ10000").ClearContents 'elimina tutti i dati dsl foglio  "MULTISEZIONI"
Worksheets("MULTISEZIONI").Range("A1:ZZ10000").ClearContents 'elimina tutti i dati dsl foglio  "MULTISEZIONI"
Worksheets("MULTISEZIONI").Range("A1:ZZ10000").ClearFormats  'elimina la formattazione dal foglio  "MULTISEZIONI"

Worksheets("SPOOL").Select ' SELEZIONA il foglio "SPOOL"
Range("A1:G1").Select ' SELEZIONA LE CELLE : A1:M1
Selection.AutoFilter   ' TOGLIE IL FILTRO
Worksheets("SPOOL").Range("A2:ZZ10000").ClearContents 'elimina tutti i dati dsl foglio  "SPOOL"
Worksheets("SPOOL").Range("A2:ZZ10000").ClearContents 'elimina tutti i dati dsl foglio  "SPOOL"

Worksheets("SPOOL1").Select ' SELEZIONA il foglio "SPOOL1"
Worksheets("SPOOL1").Range("A1:ZZ10000").ClearContents 'elimina tutti i dati dsl foglio  "SPOOL1"
Worksheets("SPOOL1").Range("A1:ZZ10000").ClearContents 'elimina tutti i dati dsl foglio "SPOOL1"
Worksheets("SPOOL1").Range("A1:ZZ10000").ClearFormats  'elimina la formattazione dal foglio  "SPOOL1"

Worksheets("REG_PORTALE").Select ' SELEZIONA il foglio "REG_PORTALE"
Range("A1:M1").Select ' SELEZIONA LE CELLE : A1:M1
Selection.AutoFilter   ' TOGLIE IL FILTRO
Worksheets("REG_PORTALE").Range("A1:ZZ10000").ClearContents 'elimina tutti i dati dsl foglio "REG_PORTALE"
Worksheets("REG_PORTALE").Range("A1:ZZ10000").ClearContents 'elimina tutti i dati dsl foglio "REG_PORTALE"
Worksheets("REG_PORTALE").Range("A1:ZZ10000").ClearFormats 'elimina tutti i dati dsl foglio "REG_PORTALE"

MsgBox "Finito"

Worksheets("START").Activate

TempoFin = Time()
MsgBox "la durata della macro è stata di :" & (TempoFin - TempoINI) * 60 * 60 * 24

Resume Next
Application.ScreenUpdating = True
End Sub

[Luca73Partecipante Luca73 Karma: 58 pts]

Ciao Elimina le righe

For Indice = 1 To 2
 Application.Wait (Now + TimeValue("0:00:01") * 1.5)
Next Indice

sono una pausa che mi era servita per testare il programmino.

Funziona?

 

[mflautoPartecipante mflauto Karma: 1 pt]

Ti ringrazio Luca,

funziona ma non è molto attendibile 🙂 se la mandi 2 - 3 volte in esecuzione la macro calcola dei tempi errati.

[scossaPartecipante scossa Karma: 37 pts]

Usa la funzione microtimer():

 

'MicroTimer function
'Found on the net
'
#If VBA7 Then

  Private Declare PtrSafe Function getFrequency _
              Lib "kernel32" _
              Alias "QueryPerformanceFrequency" ( _
              cyFrequency As Currency) _
              As Long
  
  
  Private Declare PtrSafe Function getTickCount _
              Lib "kernel32" _
              Alias "QueryPerformanceCounter" _
              (cyTickCount As Currency) _
              As Long
#Else
  Private Declare Function getFrequency _
              Lib "kernel32" _
              Alias "QueryPerformanceFrequency" ( _
              cyFrequency As Currency) _
              As Long
  
  
  Private Declare Function getTickCount _
              Lib "kernel32" _
              Alias "QueryPerformanceCounter" _
              (cyTickCount As Currency) _
              As Long
#End If


Public Function MicroTimer() As Double
    Dim cyTicks1 As Currency
    Static cyFrequency As Currency
    MicroTimer = 0
    If cyFrequency = 0 Then getFrequency cyFrequency
    getTickCount cyTicks1
    If cyFrequency Then MicroTimer = cyTicks1 / cyFrequency
End Function


Sub TuaSub()
  Dim nStart As Double
  Dim nStop As Double
  
  nStart = MicroTimer
'
'istruzioni della tua sub
'
  nStop = MicroTimer - nStart
  Debug.Print nStop
  
End Sub

[Luca73Partecipante Luca73 Karma: 58 pts]

Ciao Scossa, 

c'è sempre da imparare....

GRAZIE mille

Luca

[Autore]

Articoli