如果范围If
中的值在当前日期的2天内,我如何编写一个datereconcile
语句来提示msgbox?
Sub upcoming_alert()
Dim qw As Variant
Dim datereconcile As Range
Dim DATEROW As Long
Dim nowpos2, nowneg2 As Long
Set wb = ThisWorkbook
Set datereconcile = wb.Sheets(1).Range("H:H")
DATEROW = datereconcile(datereconcile.Cells.Count).End(xlUp).Row ' Get last filled cell
Set datereconcile = Range(datereconcile(1), datereconcile(DATEROW)) ' Reduce rng size
nowpos2 = Date - 2
nowneg2 = Date - 1
For Each qw In datereconcile
If qw.Value >= nowpos2 Then
MsgBox ("Date drop upcoming")
End If
Next
End Sub
答案 0 :(得分:2)
我实际上会稍微修改你的代码。我更喜欢使用简单的For
循环并使用整数变量而不是For Each qw In datereconcile
(我更喜欢和更快地解码)。以下宏将获取H(8)列中的所有单元格,并从第1行转到第n 行。然后它会查看日期值并将其与今天的日期进行比较。如果日期在今天的2天内,它将在调试控制台中打印日期(VBA编辑器中的 Ctrl + G)。如果您愿意,可以将其替换为警报功能。
添加IsDate
检查以确保在存储字符串而不是列H中的日期时不会出现错误。
Sub upcoming_alert()
'Dimensions all variables
Dim wb As Workbook
Dim lastRow As Integer
Dim daySpan As Integer
Dim Ro As Integer
Dim Co As Integer
'the date column in numerical format (represents column H)
Co = 8
'Creates a reference to the parent of all child objects inside of the WITH clause
With ThisWorkbook
'Determines the last date in the given column
lastRow = .Sheets(1).Cells(.Sheets(1).Rows.Count, Co).End(xlUp).Row
'The number of days you want to "look around" from today's date
daySpan = 2
'Loops through all the rows in the
For Ro = 1 To lastRow
'Checks to make sure the given cell's value is a date and not a string
If IsDate(CDate(.Sheets(1).Cells(Ro, Co))) Then
'Casts the give value in the cell as a date (CDate)
'Subtracts today's date from the current value
'Takes the absolute value and compares it to daySpan (2 by default) as a "2 day lookaround"
If Abs(CDate(.Sheets(1).Cells(Ro, Co)) - Date) <= daySpan Then
'removed the alert because I didn't want to have to hit enter a bunch of times
'DO SOMETHING IN HERE
Debug.Print .Sheets(1).Cells(Ro, Co)
End If
End If
Next
End With
End Sub