Automatisches addieren nach einer bestimmten Zeit

Forumthread: Automatisches addieren nach einer bestimmten Zeit

19.06.2008 12:57:08

Moritz

Hallo!
Ich habe in einer Zelle einen Wert drin stehen, der in einem bestimmten Zeitintervall z.B. alle 30 sek oder alle 5 min sich ändern soll. Auf diesen Wert soll immer ein weiterer fester Wert nach dem Ablauf der Zeit addiert werden.
Und es wäre gut, wenn in einer anderen Zelle die Zeit mit Sekunden läuft, wann das nächste Mal addiert wird.
Hat jemand eine Idee, wie ich das mit einem Makro machen könnte bzw. ist so etwas überhaupt möglich?
Viele Grüße
Moritz

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Automatisches addieren nach einer bestimmten Zeit

19.06.2008 14:16:00

UweD

Hallo
Teil1: habe ich fertig


Sub StartAutosumme()
Autosumme
End Sub


Sub Autosumme()
Dim NextInst As Date
On Error GoTo Fehler
'in A2 soll die Summe stehem
'In B2 soll die Summe stehen.
With ActiveSheet
.Range("A2") = .Range("A2") + .Range("B2")
End With
NextInst = Now + TimeValue("00:00:30")
Application.OnTime NextInst, "Autosumme"
Fehler:
If Err.Number  0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear
If Err.Number  0 Then Resume Next
End Sub


Sub StopAutosumme()
Dim NextInst
On Error Resume Next
Application.OnTime NextInst, "Autosumme", , False
End Sub

muß in eine Standardmodul


Sub StartAutosumme()
Autosumme
End Sub


Sub Autosumme()
Dim NextInst As Date
On Error GoTo Fehler
'in A2 soll die Summe stehem
'In B2 soll die Summe stehen.
With ActiveSheet
.Range("A2") = .Range("A2") + .Range("B2")
End With
NextInst = Now + TimeValue("00:00:30")
Application.OnTime NextInst, "Autosumme"
Fehler:
If Err.Number  0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear
If Err.Number  0 Then Resume Next
End Sub


Sub StopAutosumme()
Dim NextInst
On Error Resume Next
Application.OnTime NextInst, "Autosumme", , False
End Sub

Gruß Uwe D

AW: Automatisches addieren nach einer bestimmten Zeit

19.06.2008 14:28:02

Moritz

Hey Uwe,
das funktioniert ja schon mal klasse! Danke! Ich habe die 3 Teile einfach in ein Modul kopiert und Autosumme gestartet. Wie kann ich das denn dann wieder stoppen =)?
Und kann ich es so einstellen, dass das Makro automatisch stoppt, wenn es eine bestimmte Zahl z.B. 100 erreicht hat. Das Makro sollte wieder anfangen zu laufen sobald die Zahl kleiner als 100 wird und dann wieder bis 100 addieren.
ist das möglich?
Vielen Dank!
Moritz

AW: Automatisches addieren nach einer bestimmten Zeit

19.06.2008 15:21:07

UweD

Hallo nochmal
hier nochmal der kompl. Code.
Wichtig ganz oben muß die Declination der Variablen stehen. und nicht im Teilcode selbst.

Option Explicit
Dim NextInst, NextRest
Sub StartAutosumme()
    Autosumme
    Restzeit
End Sub
Sub Autosumme()
    Dim Konstante&
    Konstante = 5
    On Error GoTo Fehler
    'in A2 soll die Summe stehem
    With ActiveSheet
        If .Range("A2") <= 100 Then
            .Range("A2") = .Range("A2") + Konstante
        End If
    End With
    NextInst = Now + TimeValue("00:00:15")
    Application.OnTime NextInst, "Autosumme"
Fehler:
    If Err.Number <> 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear
    If Err.Number <> 0 Then Resume Next
End Sub
Sub Restzeit()
    Dim TT
    On Error GoTo Fehler
    'in C2 soll die Restzeit stehen
    ActiveSheet.Range("C2") = Format(NextInst - Now, "hh:mm:ss")
    NextRest = Now + TimeValue("00:00:01")
    Application.OnTime NextRest, "Restzeit"
Fehler:
    If Err.Number <> 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear
    If Err.Number <> 0 Then Resume Next
End Sub
Sub StopAutosumme()
    On Error Resume Next
    Application.OnTime NextRest, "Restzeit", , False
    Application.OnTime NextInst, "Autosumme", , False
End Sub

- Gestarter wird über: "StartAutosumme"
- beendet über: "StopAutosumme"
____ dazu kannst du dir ja Buttons anlegen
- Wenn 100 erreicht ist, wird nicht weiteraddiert aber das Makro läuft immer noch weiter
- wenn du nun manuelll in der Zelle die Zahl wieder unter 100 setzt, wird wieder addiert....
Gruß UweD

Vielen Dank

19.06.2008 16:10:31

Moritz

Hallo Uwe,
so habe alles eingebaut und läuft super!
Viele Grüße
Moritz

Beliebteste Forumthreads (12 Monate)

Automatisches addieren nach einer bestimmten Zeit

Forumthread: Automatisches addieren nach einer bestimmten Zeit

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Automatisches addieren nach einer bestimmten Zeit

Forumthread: Automatisches addieren nach einer bestimmten Zeit

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread