VBA - 从现在功能中删除秒

Posted 2023-02-25

【中文标题】VBA - 从现在功能中删除秒

【英文标题】：VBA - Remove Seconds from NOW function

【发布时间】：2016-02-04 20:57:47

【问题描述】：

我有一些事情会在它发生前一小时通知我。为此，我在 VBA 中使用 NOW 函数，因为我还需要它来检查日期。

问题是脚本每 20 秒运行一次，所以我不能让它考虑 NOW 函数的秒数。

有没有办法去除这些？只有喜欢 (DAY,MONTH,YEAR,HOUR,MINUTE)？

类似的东西：

 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

【参考方案1】：

您可以将 MyLimit 舍入到最接近的分钟数：

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

请考虑，在将其与单元格的内容进行比较时，您可能需要使用<= 或>= 比较以避免在“错误”时间更改时间以使等式成立时出现问题。

【讨论】：

这很有效！谢谢我经历了很多可能性！

如果我想在现在 30 分钟前收到通知，我该怎么做？我不太擅长编写函数的多个修改：P

@FrancisMaltais 只需在MyLimit 上添加 30 分钟，然后再进行比较。 30 分钟 = 30/1440 或 Timeserial(0,30,0)

类似：MyLimit = (Round(Now * 1440, 0) / 1440) - 30 / 1440 ?

@FrancisMaltais 你可以，但为了清楚起见，我会使用两行；第一个用于 Round MyLimit，第二个用于增加或减少 30 分钟。

【参考方案2】：

要去除Now 的秒数，您可以使用一些数学或往返文本转换。

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

这两个都返回一个真实的数字日期时间值，其中秒数被剥离。它们不会将秒数平均到最接近的分钟数；只需删除它们。

【讨论】：

我相信 CLng 会四舍五入（并四舍五入到最接近的偶数）

你确实是对的；我一定混淆了我尝试过的几种方法的结果。

非常感谢 Jeeped，看起来这也可行 :) 我会采用 Ron 的解决方案，因为他发布的速度更快，而且他的作品也很棒！真的很感谢！

@FrancisMaltais - 不用担心；这里有很多好主意。然而，我会质疑你对“更快”的定义，因为我的帖子比罗恩的帖子早七分钟。

哦，那是真的，我误读了时代。我的坏 D：我可以选择 2 个最佳答案吗？

【参考方案3】：

另一种方法是这样的：

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

second(now) 返回秒，/60/60/24 将其转换为天，每个日期和时间都存储在其中。使用这个或 Jeeped 的答案，其中任何一个都应该工作。

编辑：

为了避免微小但存在的错误可能性，请使用：

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

【讨论】：

谢谢 :) 看起来它也可以！真的很感激。

【参考方案4】：

尝试限制 = Format((Now), "DD/MM/YYYY HH:MM")

【讨论】：

当我尝试 MyLimit = Format((Now), "DD/MM/YYYY HH:MM") 时出现运行时错误“13” - 类型不匹配

【参考方案5】：

使用 Date 函数而不是 NOW 函数 https://msdn.microsoft.com/en-us/library/aa227520(v=VS.60).aspx

更新

【讨论】：

当我这样做时，它无法检查一天中的时间：/

所以如果我使用日期并且我的参考单元格是 02/04/2016 - 4:02 PM，我什么也得不到。但仅使用 02/04/2016 日期时它确实有效。

格式怎么样(NOW(), "dd/mm/yyyy - hh:mm AM/PM")

当我尝试 MyLimit = Format((Now), "DD/MM/YYYY HH:MM") 时出现运行时错误“13” - 类型不匹配

此外，如果我删除 MyLimit 并执行以下操作，则脚本不会触发： If .Value = Format((Now), "DD/MM/YYYY HH:MM") 另外，我注意了将范围内的单元格格式化为自定义格式 DD/MM/YYYY HH:MM

【参考方案6】：

我通常只使用函数=TIME(HOUR(NOW()),MINUTE(NOW()),0)

【参考方案7】：

每个 VBA Office 2010 及更高版本的替代方法：

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

请注意，减号 (-) 会删除秒数。

更多信息https://msdn.microsoft.com/en-us/library/office/gg251759.aspx