Views

Histats

Vitrine

VBA Tips - Retornando Milissegundos

Inline image 1

Hello again folks!

Medir o tempo de processamento de certos momentos das nossas aplicações é sumamente importante para otimizarmos os nossos códigos, processos, acessos, etc... Essa prática não deve ser ignorada, antes, devemos re-escrever códigos, algoritmos, mudarmos técnicas e experimentarmos até encontrarmos a mais eficiente.

Faça questão de medir a performance das suas queries, a geração de arquivos em determinandos processo de automação. Busque identificar qual é a interface que se comporta melhor no ambiente para o qual está desenvolvendo.

Mas, para medir, precisa mensurar, detectar. Como? Fácil, a função abaixo lhe permitirá tal liberdade.

Function MilisSeconds() As String

Let MilisSeconds = Strings.Format(Now, "dd-MMM-yyyy HH:nn:ss") & "." & Strings.Right(Strings.Format(Timer, "#0.00"), 2)

End Function

Mas como posso aplicar isso nas minhas procedures e functions ?


Private Sub btnSave_Click()
    ' Author:                     Date:               Contact:
    ' André Bernardes             10/05/2011 15:31    bernardess@gmail.com     http://inanyplace.blogspot.com/
    ' Application: ********.
    ' Cria a **************************************.
    ' Listening: Recognizer - Daft Punk - Tron Legacy.

    Dim nStart As String

    DoCmd.RunCommand acCmdSaveRecord

    Let nStart = Right(TimeInMS(), 11) 'Right(Now(), 8)

    Call AdjustSpecialties
    Call AssemblerCentralEngine
    Call AssemblerCentralEngine2
    Call SeedData                                                    ' Arquiva os dados para consulta e análise posteriores

    Me.cmbCenarios.Requery                                    ' Atualiza o Combo de Exclusão de cenários.

    Let Me.cxVersion.Value = Now() & " Versão 00"   ' Atualiza a caixa de texto onde se dá os nomes para novos cenários.

    MsgBox "Tabela criada com sucesso!" & Chr(10) & Chr(13) & _
           "" & Chr(10) & Chr(13) & _
           " TABELA: tbl_Bernardes" & Chr(10) & Chr(13) & _
           "" & Chr(10) & Chr(13) & _
           "CENÁRIO: " & ReturnVersion() & Chr(10) & Chr(13) & _
           "" & Chr(10) & Chr(13) & _
           "Iniciou em: " & nStart & " - Finalizou em: " & Right(TimeInMS(), 11) & Chr(10) & Chr(13) & _
           "" & Chr(10) & Chr(13) & _
           "Os dados foram preservados para análises posteriores." & Chr(10) & Chr(13) & _
           "", vbInformation, ".: Informação: Versão " & ReturnVersion()
End Sub

Existe um outro modo de ter este mesmo resultado, utilizando API e DLL. Não acredito que seja mais útil, mas em todo caso, teste-o você mesmo se desejar:

Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type

Private Declare Sub GetSystemTime Lib "kernel32" 
(lpSystemTime As SYSTEMTIME)
Public Function nMillisecond() As String
Dim tSystem As SYSTEMTIME
Dim nRet
On Error Resume Next
GetSystemTime tSystem
Let sRet = Hour(Now()) & ":" & Minute(Now()) & ":" & Second(Now()) & _
":" & tSystem.wMilliseconds
Let nMillisecond = nRet
End Function

Vocês sabem como sou, se existe um outra forma, e a conheço, não deixo de lhes mostrar (medindo processamento em centésimos de segundos com o método Timer):

Public Sub TestBernardes()
Dim fTimeStart As Single
Dim fTimeEnd As Single
Let fTimeStart = Timer

SomeProcedure

Let fTimeEnd = Timer

Debug.Print Format$((fTimeEnd - fTimeStart) * 100!, "0.00 "" Centésimos de segundos""")
End Sub


Public Sub SomeProcedure()
    Dim i As Long, r As Double

    For i = 0& To 10000000
        Let r = Rnd
    Next

End Sub


Reference:

VBAADUD
Excel Forum
Stack Overflow


Inspiration:


TagsVBA, Tips, API, Millisecond, milesegundos, Milliseconds, timer, get, DLL, milissegundo, timer


✔ VBA Brazil®

✔ VBA Brazil®
brazilsalesforceeffectiveness@gmail.com
Related Posts Plugin for WordPress, Blogger...
diHITT - Notícias