Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1288to1292
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Zeitberechnung in Millisekunden

Zeitberechnung in Millisekunden
18.12.2012 12:37:18
Albert
Hallo zusammen,
aus einem früheren Forumseintrag hab ich diesen Code gezogen, der wunderschön Millisekunden anzeigt.
Mein Problem, dass ich nicht nur eine Taste als Zwischenzeitmessung verwenden möchte, sondern sieben.
Hier der alte Code...
Private Sub startWatch()
resetWatch
bStop = False
dblT = Timer
Me.Shapes("shpStop").Visible = True
Me.Shapes("shpLap").Visible = True
Me.Shapes("shpStart").Visible = False
On Error Resume Next
Do
DoEvents
Range("D6") = (Timer - dblT) / 86400
DoEvents
Loop While bStop = False
End Sub
Private Sub stopWatch()
bStop = True
Rows(10).Insert
Range("B10:D10").Font.ColorIndex = 23
Range("B11:D11").Font.ColorIndex = 15
Range("B10") = "Endtime:"
Range("D10") = Range("D6")
Me.Shapes("shpReset").Visible = True
Me.Shapes("shpStop").Visible = False
Me.Shapes("shpLap").Visible = False
End Sub
Private Sub lap()
lngR = lngR + 1
Rows(10).Insert
Range("B10:D10").Font.ColorIndex = 23
Range("B11:D11").Font.ColorIndex = 15
Range("B10") = "Lap " & Format(lngR, "000") & ":"
Range("D10") = Range("D6")
End Sub
Private Sub resetWatch()
lngR = 0
Range("D6") = 0
With Range("B10:D" & Rows.Count)
.ClearContents
.Font.ColorIndex = 15
End With
Me.Shapes("shpStart").Visible = True
Me.Shapes("shpStop").Visible = False
Me.Shapes("shpLap").Visible = False
Me.Shapes("shpReset").Visible = False
End Sub

Wie muss ich den Code umbauen?
Ich möchte z.B. die erste Taste so aufbauen.
a. Schreibe mir in die Spalte F eine "1"
b. Schreibe mir in die Spalte D die bereits verstrichene Zeit
c. Schreibe mir die Zeitdifferenz zwischen Start und der verstrichenen Zeit (bzw. letzten Tastendruck)
Bisher hab ich es leider nicht geschafft, den obigen Code so zu trennen, dass es funktioniert. Vorallem weil mir das lngR + 1 immer einen Strich durch die Rechnung gemacht hat. Es soll der neue Wert nicht oben eingetragen werden (die vorangegangenen Zeiten werden nach unten geschoben), sondern es soll nach unten erweitert werden.
Dank & LG
Albert

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zeitberechnung in Millisekunden
18.12.2012 13:45:45
Albert
Servus Leute,
manchmal bringt es wirklich was, wenn man sich nen Kaffee holt und nochmal das Problem von etwas weiter weg anschaut...
Die Codeteilung hab ich soweit jetzt durch.
Vielleicht hilfts mal jemandem weiter:
Private bStop As Boolean
Private lngR As Long
Private Sub Start_Zeitaufnahme_Click()
Dim start As Double, x, dummy
If Start_Zeitaufnahme.Value = False Then _
With Start_Zeitaufnahme
.Caption = "Starten der Zeitaufnahme"
.BackColor = RGB(22, 149, 5)
End With
bStop = True 'Stoppuhr der Zeitaufnahme angehalten
i = Sheets("Zeitentabelle").Cells(Rows.Count, "D").End(xlUp).Row + 1
Cells(i, "D").Activate
Cells(i, "D").Value = Range("D6")
i = Sheets("Zeitentabelle").Cells(Rows.Count, "D").End(xlUp).Row
Cells(i, "A").Activate
Cells(i, "A").Value = "Ende der Zeitaufnahme"
i = Sheets("Zeitentabelle").Cells(Rows.Count, "D").End(xlUp).Row
Cells(i, "F").Activate
Cells(i, "F").Value = "0"
End If
If Start_Zeitaufnahme.Value = True Then _
With Start_Zeitaufnahme
.Caption = "Zeitaufnahme läuft"
.BackColor = RGB(255, 0, 0)
End With
Range("A15").Value = "Start der Zeitaufnahme"
Range("F15").Value = "0"
Range("D15").Value = Format(Timer, lngR, "000") & ":"
On Error Resume Next    'Stoppuhr der Zeitaufnahme starten
Do
DoEvents
Range("D6") = (Timer - dblT) / 86400
DoEvents
Loop While bStop = False
End If
End Sub
Private Sub Haupttätigkeit_Click()
Dim i As Long
If Start_Zeitaufnahme = False Then _
MsgBox ("Keine Funktion, da die Zeitaufnahme noch nicht gestartet wurde!") _
Else
i = Sheets("Zeitentabelle").Cells(Rows.Count, "D").End(xlUp).Row + 1
Cells(i, "D").Activate
Cells(i, "D").Value = Format(lngR, "000") & ":"
Cells(i, "D").Value = Range("D6")
i = Sheets("Zeitentabelle").Cells(Rows.Count, "F").End(xlUp).Row + 1
Cells(i, "F").Activate
Cells(i, "F").Value = "1"
i = Sheets("Zeitentabelle").Cells(Rows.Count, "F").End(xlUp).Row
Cells(i, "C").Activate
Cells(i, "C").Value = "Haupttätigkeit"
End Sub
ABER:
Ich hab jetzt noch versucht, dass ich den Zeitstempel beim Drücken der START-Taste wegschreiben lasse. Doch der bringt mir ein ganz komisches Format.
Weiß vielleicht jemand von euch da weiter?
LG
Albert

Anzeige
AW: Zeitberechnung in Millisekunden
18.12.2012 13:47:04
Albert
Oh, noch was!
Der Timer funktioniert nicht immer!!!!
D.h. wenn ich den Timer starte, läuft er normal. Wenn ich ihn erneut starte, funzelts nicht mehr...
an was könnte das liegen?
LG
Albert

Problem gelöst => owT
18.12.2012 15:25:18
Albert
...

308 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige