Zeit immer um 5 minuten aufrunden mit VBA

[Niko]

Hallo an alle,
 
brauche ein bisschen Unterstützung bei meinen vorhaben.
 
Möchte mit der rechten Mausetaste das sich automatisch die laufende Zeit einträgt, in bestimmten Bereichen.
Soweit so gut, habe es hinbekommen.
 
Möchte aber dazu das beim rechten Mausklick sich die laufende Zeit einträgt immer auf 5 Minuten aufgerundet.
 
Beispiel: ist es 07:01 soll es 07:05 werden beim Klicken der rechte maustaste.
Ist es 07:07 dann soll es 07:10  beim Klicken werden, usw.
 
Wie kann ich das in mein vorhandenen VBA Code einbauen?
 
Anbei der VBA Code:

Code:

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
ActiveWorkbook.ActiveSheet.Unprotect ("1234")

If Not Intersect(Target, Range("C6:D36, G6:H36, K6:L36, R6:S36")) Is Nothing Then
        Target = IIf(Target = "", Time, "")
        Cancel = True
    End If
ActiveWorkbook.ActiveSheet.Protect ("1234")
End Sub

Danke im Voraus

Niko   :78:

[LCohen]

Statt Time: -Int(-Time * 288) / 288

(Rest Deines Ereignisses nicht getestet, insb. auf evtl. nötiges Application.EnableEvents)

[Niko]

Vorab Großes Dank für Ihre Antwort.
 
Funktioniert Super!! :18:
 
 
Wenn Sie mir noch es erklären könnten wäre ich von meiner Finsternis erlöst  :21: ...wieso 288? und dann noch * und /

Code:

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
ActiveWorkbook.ActiveSheet.Unprotect ("1234")

If Not Intersect(Target, Range("C6:D36, G6:H36, K6:L36, R6:S36")) Is Nothing Then
        Target = IIf(Target = "", -Int(-Time * 288) / 288, "")
        Cancel = True
    End If
ActiveWorkbook.ActiveSheet.Protect ("1234")
End Sub

Danke,

Niko :78:

[LCohen]

5 Minuten sind 1/288 Tag.

Int rundet im negativen Bereich Zahlen am Zahlenstrahl weiterhin auf Ganzzahl ab (also betragsmäßig: auf).

Ich hebe also die Minuten auf Ganzzahlniveau (Datum), runde dort (via Negation) auf, und gehe mit / zurück auf 5-Minuten-Schritte. Dann negiere ich zurück.

Wenn Dir das alles nichts sagt, verwendest Du die Formel von innen nach außen, um zu sehen, was passiert.

[Niko]

Danke jetzt habe ich es kappiert.

Wenn ganze Stunde *24 ist, für halbe Stunden multiplizieren und teilen mit 48, für Viertelstunden mit 96, für zehn Minuten mit 144, für fünf Minuten mit 288.

:43: Niko

[Niko]

Jetzt wo es so gut klappt werde ich hochmütig und erlaube mir Ihnen noch eine frage zu stellen.

Wie kann ich es bewerkstelligen das wenn in bsp. A1 das wort "Woche" steht das es mit rechtem mausklick immer 5 minuten aufrundet.
Wenn aber in A1 das wort "Monat" steht das es um 30 minuten immer aufrundet?

Code:

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
ActiveWorkbook.ActiveSheet.Unprotect ("1234")

If Not Intersect(Target, Range("C6:D36, G6:H36, K6:L36, R6:S36")) Is Nothing Then
        Target = IIf(Target = "", -Int(-Time * 288) / 288, "")
       ‘ Target = IIf(Target = "", -Int(-Time * 48) / 48, "")
        Cancel = True
    End If
ActiveWorkbook.ActiveSheet.Protect ("1234")
End Sub

Danke...kann es nicht genug schreiben :78:

[LCohen]

Aus (beide Male!) 288 (in meiner Erweiterung) wird dann (ungetestet; bitte selbst umklammern!):

1440 / (1 - 4 * ([A1] = "Woche") - 29 * ([A1] = "Monat"))

Steht also nichts in A1, wird nur auf die nächste Minute aufgerundet.

Boole'sche Werte in VBA sind 0, -1 im Ggs zu Excel mit 0, 1.

Oder, übersichtlicher so:

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
ActiveWorkbook.ActiveSheet.Unprotect ("1234")

If Not Intersect(Target, Range("C6:D36, G6:H36, K6:L36, R6:S36")) Is Nothing Then
        Frac = 1440 / (1 - 4 * ([A1] = "Woche") - 29 * ([A1] = "Monat"))
        Target = IIf(Target = "", -Int(-Time * Frac) / Frac, "")
        Cancel = True
    End If
ActiveWorkbook.ActiveSheet.Protect ("1234")
End Sub

[Niko]

Excellent!

Vielen, vielen Dank :28:


Habe ich etwas dazu gelernt...es ist immer wieder faszinierend

Ein Song als dankeschön von mein Lieblingssänger  :64: :

Everybody knows 


Thx
Niko :78:

[snb]

In Excel:
A1: Monat oder Woche (M ode W reicht)

PHP-Code:

=CEILING(A2;1/(288-240*(LEFT(A1;1)="M"))) 


In VBA

Code:

target=Round(Target, 2) + 1 / (288 + 240 * (Left([A1], 1) = "M"))

[Niko]

Wie/Wo würde dies in mein Code passen?

Code:

If Not Intersect(Target, Range("C6:D36, G6:H36, K6:L36, R6:S36")) Is Nothing Then
        Frac = 1440 / (1 - 4 * ([A1] = "Woche") - 29 * ([A1] = "Monat"))
        Target = IIf(Target = "", -Int(-Time * Frac) / Frac, "")
        Cancel = True
    End If
ActiveWorkbook.ActiveSheet.Protect ("1234")
End Sub

mit

Code:

Frac = 1440 / (1 - 4 * ([A1] = "Woche") - 29 * ([A1] = "Monat"))

bekomme ich laufzeitfehler.

In Ihren VBA Code sehe ich nicht die auswahlmöglichkeit für "W".

Danke,
Niko