VBA - 仅检查DD / MM / YYYY - HH / MM / SS值内的日期

时间:2016-02-05 15:28:54

标签: excel vba excel-vba date

我已经检查了多个主题,但遗憾的是我无法找到我需要的解决方案。

我的单元格需要包含以下自定义格式的日期和时间:dd / mm / yyyy hh:mm

我有一些检查这些细胞的东西,看它是否匹配。如果是的话,它通知我它正在接近它的到期时间。

Dim MyLimit         As Double

MyLimit = Date

Set FormulaRange = Range("E5:E35")    
For Each FormulaCell In FormulaRange.Cells
    With FormulaCell
            If .Value = MyLimit Then
                *Do the action*

如果我在单元格中设置日期值(例如02/05/2016),这可以正常工作,因为它默认为午夜并触发操作。虽然02/05/2016 2:45 PM不起作用。

所以我需要做的是只检查单元格的第一部分是否有日期值,如果它符合今天的日期,则触发操作。

我尝试了一些解决方案,例如:

Dim MyLimit         As Double

MyLimit = CDate(format(Date, "dd-mmm-yyyy"))

Set FormulaRange = Range("E5:E35")    
For Each FormulaCell In FormulaRange.Cells
    With FormulaCell
            If .Value = MyLimit Then
                *Do the action*

Dim MyLimit         As Date

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

Set FormulaRange = Range("E5:E35")    
For Each FormulaCell In FormulaRange.Cells
    With FormulaCell
            If .Value = MyLimit Then
                *Do the action*

但它不起作用。它没有检测到它应该像date = today那样进行操作。

任何人都可以启发我吗?

实际脚本:

Option Explicit

Public Function AutoRun()
Application.OnTime Now + TimeValue("00:01:00"), "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 Double
Dim MyLimit2        As Double


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

MyLimit = Date
MyLimit2 = ((Round(Now * 1440, 0) - 30) / 1440)

Set FormulaRange = Range("E5:E35")
On Error GoTo EndMacro:
For Each FormulaCell In FormulaRange.Cells
    With FormulaCell
            If DateValue(.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

            If .Value = MyLimit2 Then
                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 个答案:

答案 0 :(得分:1)

  

所以我需要做的是只检查单元格的第一部分的日期值

使用DateValue功能,例如:

 If DateValue(.Value) = MyLimit Then
     ' *Do the action*

注意:Date类型包含日期时间部分。

DateValue函数仅返回Date类型的日期部分。还有TimeValue函数,该函数仅从Time Part类型返回Date

您的Mismatch错误的一些修订,使用值2/5/2016 14:45进行了测试:

Dim MyLimit As Date

MyLimit = Date

Set FormulaRange = Range("E5:E35")
For Each FormulaCell In FormulaRange.Cells
    With FormulaCell
            If DateValue(.Value) = MyLimit Then
                ' Do something...