我已经检查了多个主题,但遗憾的是我无法找到我需要的解决方案。
我的单元格需要包含以下自定义格式的日期和时间: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
答案 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...