Auf Viertelstunde auf/abrunden

  • Excel

Es gibt 3 Antworten in diesem Thema. Der letzte Beitrag () ist von petaod.

    Auf Viertelstunde auf/abrunden

    Guten Morgen,

    ich versuche über VBA einen Bereich (C10 bis L16), in dem Uhrzeiten stehen, auf 15 Minuten auf- bzw. abzurunden.
    Leider wird in die Zelle wird #NAME? geschieben, sobald ich den Wert runden möchte.
    Ich hab aktuelle keine Ahnung, was an der Formel falsch ist, denn trage ich anstelle 'Hour(rcell.value)' die Zelle direkt ein 'Hour(C10)', funktioniert das ganze.

    Hier mal meinen Code:

    Visual Basic-Quellcode

    1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    2. Dim rCell As Range
    3. For Each rCell In ActiveSheet.Range("C10:L16")
    4. If rCell.Value <> "" Then
    5. If (Minute(rCell) >= 53) Then
    6. ' rCell.Value = rCell.Value + TimeSerial(1, 0, 0)
    7. rCell.Value = [=Time(Hour(rcell.value)+1, 0, 0)]
    8. ' rCell.Value = [=Time(Hour(Cells(rCell.Row,rCell.Column))+1, 0, 0)]
    9. ' rCell = [=Time(Hour(rCell)+1, 0, 0)]
    10. ElseIf (Minute(rCell) <= 7) Then
    11. ' rCell = [=Time(Hour(rCell), 0, 0)]
    12. ElseIf (Minute(rCell) <= 22) Then
    13. ' rCell = [=Time(Hour(rCell), 15, 0)]
    14. ElseIf (Minute(rCell) <= 37) Then
    15. ' rCell = [=Time(Hour(rCell), 30, 0)]
    16. ElseIf (Minute(rCell) <= 52) Then
    17. ' rCell = [=Time(Hour(rCell), 45, 0)]
    18. End If
    19. End If
    20. Next rCell
    21. End Sub


    Danke für die Hilfe
    wintoolz.de
    • wintoolz.KeyLocker - Programm zum sicheren Verwalten von Passwörten
    • wintoolz.CodeGallery - Datenbank für Codebeispiele veschiedener Programmiersprachen
    • wintoolz.Haushaltsbuch - Dient zum Auflisten der Aktivitäten ihrer Bankkonten

    Benutze auch du Ecosia
    - Warum nicht gleich mit Excel-Formel?
    =(ROUND((A1*1440)/15; 0)*15)/1440

    -Warum im SelectionChange-Event? Das wird viel zu häufig aufgerufen.
    Ich würde da eher das Change-Event nehmen und nur abarbeiten, wenn die fragliche Sourcezellen geändert wurden.

    Und VBA-Rundung geht einfacher nach demselben Verfahren
    rCell.Value = (Round((rCell.Value * 1440) / 15, 0) * 15) / 1440
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --
    Vielen dank, das funktioniert schonmal.
    Und wie frag ich ab, ob sich die Zelle geändert hat?
    wintoolz.de
    • wintoolz.KeyLocker - Programm zum sicheren Verwalten von Passwörten
    • wintoolz.CodeGallery - Datenbank für Codebeispiele veschiedener Programmiersprachen
    • wintoolz.Haushaltsbuch - Dient zum Auflisten der Aktivitäten ihrer Bankkonten

    Benutze auch du Ecosia
    Wie oben bereits geschrieben.
    Im Change-Event:

    Visual Basic-Quellcode

    1. Private Sub Worksheet_Change(ByVal Target as Range)
    2. Dim Rng As Range
    3. Set Rng = Intersect(Target,Range("C10:L16"))
    4. If Not Rng Is Nothing Then Rng.Value = (Round((Rng.Value * 1440) / 15, 0) * 15) / 1440
    5. End Sub

    Edit:
    So funktioniert's sogar, wenn ein ganzer Zellblock geändert wird (z.B. C&P oder FillDown):

    Visual Basic-Quellcode

    1. Private Sub Worksheet_Change(ByVal Target As Range)
    2. Dim c As Range
    3. If Intersect(Target, Range("C10:L16")) Is Nothing Then Exit Sub
    4. For Each c In Intersect(Target, Range("C10:L16"))
    5. If IsDate(c) Then c.Value = (Round((c.Value * 1440) / 15, 0) * 15) / 1440
    6. Next
    7. End Sub
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „petaod“ ()