如果if值的语句是Now()之前的2天或Now()之后的2天

时间:2014-12-09 21:46:33

标签: excel vba excel-vba

如果范围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

1 个答案:

答案 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