VBA - Удалить секунды из функции СЕЙЧАС

Question

У меня есть то, что уведомляет меня за час до этого. Для этого я использую функцию NOW в VBA, так как мне нужно, чтобы она также проверяла дату.

Проблема заключается в том, что сценарий запускается каждые 20 секунд, поэтому я не могу считать его секундой для функции NOW.

Есть ли способ удалить их? Нужно только (ДЕНЬ, МЕСЯЦ, ГОД, ЧАС, МИНУТ)?

Что-то вдоль этих линий:

MyLimit = NOW(DAY,MONTH,YEAR,HOUR,MINUTE) 

For Each FormulaCell In FormulaRange.Cells 
With FormulaCell 
      If .Value = MyLimit Then 
      Call Notify 

Вот сценарий, в котором я пытаюсь обнаружить дату и время.

Option Explicit 

Public Function AutoRun() 
Application.OnTime Now + TimeValue("00:00:20"), "TaskTracker2" 
End Function 

Public Sub TaskTracker2() 
Dim FormulaCell   As Range 
Dim FormulaRange As Range 
Dim NotSentMsg  As String 
Dim MyMsg   As String 
Dim SentMsg   As String 
Dim SendTo   As String 
Dim CCTo   As String 
Dim BCCTo   As String 
Dim MyLimit   As Date 


NotSentMsg = "Not Sent" 
SentMsg = "Sent" 
SendTo = Range("D2") 
CCTo = Range("E2") 
BCCTo = Range("F2") 

MyLimit = Format((Now), "DD/MM/YYYY HH:MM") 

Set FormulaRange = Range("E5:E35") 
On Error GoTo EndMacro: 
For Each FormulaCell In FormulaRange.Cells 
    With FormulaCell 
      If .Value = MyLimit Then 
       MyMsg = SentMsg 
       If .Offset(0, 1).Value = NotSentMsg Then 
        strTO = SendTo 
        strCC = CCTo 
        strBCC = BCCTo 
        strSub = "[Task Manager] Reminder that you need to: " & Cells(FormulaCell.Row, "A").Value 
        strBody = "Hello Sir, " & vbNewLine & vbNewLine & _ 
         "This email is to notify that you that your task : " & Cells(FormulaCell.Row, "A").Value & " with the following note: " & Cells(FormulaCell.Row, "B").Value & " is nearing its Due Date." & vbNewLine & "It would be wise to complete this task before it expires!" & _ 
         vbNewLine & vbNewLine & "Truly yours," & vbNewLine & "Task Manager" 
        If sendMail(strTO, strSub, strBody, strCC) = True Then MyMsg = SentMsg 

       End If 
      Else 
       MyMsg = NotSentMsg 
      End If 
     Application.EnableEvents = False 
     .Offset(0, 1).Value = MyMsg 
     Application.EnableEvents = True 

    End With 

Next FormulaCell 
AutoRun 

ExitMacro: 
Exit Sub 

EndMacro: 
Application.EnableEvents = True 

MsgBox "Some Error occurred." _ 
    & vbLf & Err.Number _ 
    & vbLf & Err.Description 

End Sub 

Answer 1

Вы можете просто круглый MyLimit до ближайшей минуты:

MyLimit = Round(Now * 1440, 0)/1440 

Рассмотрим , сравнивая его с содержимым ячейки, вам может потребоваться сравнить <= или >= чтобы избежать проблем, если время изменится в «неправильное» время, когда равенство останется истинным.

Answer 2

Используйте функцию Date вместо NOW функционировать https://msdn.microsoft.com/en-us/library/aa227520(v=VS.60).aspx

UPDATE

Answer 3

предела Try = Format ((Теперь), "DD/MM/YYYY HH: MM")

Answer 4

Чтобы отключить секундную стрелку Now, вы можете использовать некоторые математические преобразования или преобразование текста и обратно.

CDate(format(Now, "dd-mmm-yyyy hh:mm")) 
'... or, 
CLng(Now * 1440)/1440 

Оба они возвращают истинное числовое значение даты и времени с отключенными секундами. Они не усредняют секунды до ближайшей минуты; просто удалите их.

Answer 5

Другой способ заключается в следующем:.

MyLimit = now-second(now)/60/60/24 

второй (теперь) возвращает секунды, а/60/60/24 преобразует его в дни, которые каждый дата и время хранится в Использование этого или Ответ Джипида, любой из них должен работать.

Edit:

Чтобы избежать крошечное, но существующую возможность ошибки, используйте:

MyLimit = now 
MyLimit =MyLimit -second(MyLimit)/60/60/24 

Answer 6

Я обычно просто пойти с функцией =TIME(HOUR(NOW()),MINUTE(NOW()),0)

Answer 7

Альтернативный подход в VBA Office 2010 и более поздних версий:

Dim DateWithoutSeconds : DateWithoutSeconds = DateAdd("s",-Second(Now),Now) 

Обратите внимание, что минус (-) удаляет секунды.

Более подробная информация на https://msdn.microsoft.com/en-us/library/office/gg251759.aspx