Boa tarde!!
Favor usar a pesquisa do fórum!!
Tente adaptar..
Fonte:
http://www.vbaexpress.com/kb/getarticle.php?kb_id=242
Public stopMe As Boolean
Public resetMe As Boolean
Public myVal As Variant
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 1 Then
If Target.Value = myVal And Target.Value <> "" Then
'Changed
Dim startTime, finishTime, totalTime, timeRow
startTime = Timer
stopMe = False
resetMe = False
myTime = Target.Offset(, 2).Value
Target.Offset(, 1).Select
startMe:
DoEvents
timeRow = Target.Row
finishTime = Timer
totalTime = finishTime - startTime
Target.Offset(, 1).Value = Format(myTime + totalTime, "0.0000") & " Seconds"
If resetMe = True Then
Target.Offset(, 1).Value = 0
Target.Offset(, 2).Value = 0
stopMe = True
End If
If Not stopMe = True Then
Target.Offset(, 2).Value = totalTime
Goto startMe
End If
Cancel = True
End
Else
'Not Changed
stopMe = True
Cancel = True
End If
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
myVal = Target.Value
End Sub
Ex2
Option Explicit
Dim StopTimer As Boolean
Dim Etime As Single
Dim Etime0 As Single
Dim LastEtime As Single
Dim lapnr As Integer
Private Sub ExitBtn_Click()
StopTimer = True
Unload Me
End Sub
Private Sub ResetBtn_Click()
StopTimer = True
Etime = 0
Etime0 = 0
LastEtime = 0
ElapsedTimeLbl.Caption = "00:00:00.00"
End Sub
Private Sub StartBtn_Click()
StopTimer = False
Etime0 = timer() - LastEtime
Me.Repaint
Do Until StopTimer
Etime = Int((timer() - Etime0) * 100) / 100
If Etime > LastEtime Then
LastEtime = Etime
ElapsedTimeLbl.Caption = Format(Etime / 86400, "hh:mm:ss.") & Format(Etime * 100 Mod 100, "00")
DoEvents
End If
Loop
End Sub
Private Sub StopBtn_Click()
StopTimer = True
Laplbl = ""
Beep
End Sub
Private Sub LapBtn_click()
Laplbl.Caption = ElapsedTimeLbl
lapnr = lapnr + 1
Range("A" & lapnr) = "lap " & lapnr
Range("B" & lapnr) = ElapsedTimeLbl
End Sub
Private Sub UserForm_Activate()
Range("A:B") = ""
ElapsedTimeLbl = "00:00:00.00"
End Sub
Att
Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel
Postado : 07/08/2013 9:24 am