VBA Tips - Retornando Milissegundos.

Inline image 1


Hello again folks!


Medir o tempo de processamento de certos momentos dentro da nossa aplicação serve para otimizarmos nosso código, processos, acessos, etc.

Talvez deseje medir a performance de suas queries, ou a geração de arquivos em determinando processo de automação. Talvez queira saber qual interface comporta-se melhor no ambiente para o qual está desenvolvendo.

Como fazer isso, como medir, mensurar, detectar?

Fácil, a função abaixo lhe permitirá tal liberdade.

Public 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 ? Segue exemplo:

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étodoTimer):

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


ReferênciasVBAADUD
                      Excel Forum
                 Stack Overflow

Tags: VBA, Tips, milissegundo, timer, milliseconds


Nenhum comentário:

Postar um comentário

diHITT - Notícias