使用VBA Excel复制符合日期范围标准的数据行

时间:2015-09-16 19:14:30

标签: excel vba excel-vba date-arithmetic

我试图修改代码我必须将结果限制复制到另一个工作表。现在一切都被复制了>今天。它将H列的失效日期与今天的日期进行了比较。我想限制结果以包括所有包含有效期>的行。今天和<今天+ 60天。我尝试过不同的方法和功能,比如定义结束日期并使用DateAdd函数。没有什么工作,请帮忙!谢谢!

Sub SearchForExpiryDate()

       Dim LSearchRow As Integer
       Dim LCopyToRow As Integer

       On Error GoTo Err_Execute

       'Start search in row 8
       LSearchRow = 8

       'Start copying data to row 2 in Expiring MOCs (row counter variable)
       LCopyToRow = 2


       While Len(Range("A" & CStr(LSearchRow)).Value) > 0


          'If value in column H > Today, copy entire row to "Expiring_MOC"
          If Range("H" & CStr(LSearchRow)).Value > Now() Then

             'Select row in MOC_MASTER to copy
             Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
             Selection.Copy

             'Paste row into "Expiring_MOCs" in next row
             Sheets("Expiring_MOCs").Select
             Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
             ActiveSheet.Paste

             'Move counter to next row
             LCopyToRow = LCopyToRow + 1

             'Go back to 'MOC MASTER' to continue searching
             Sheets("MOC_MASTER").Select

          End If

          LSearchRow = LSearchRow + 1

       Wend

       'Position on cell A3
       Application.CutCopyMode = False
       Range("A3").Select

       MsgBox "All matching data has been copied."

       Exit Sub

    Err_Execute:
       MsgBox "An error occurred."

    End Sub

1 个答案:

答案 0 :(得分:0)

如果以下行在旧条件下工作,

If Range("H" & CStr(LSearchRow)).Value > Now() Then

...将其更改为包含新条件(60天限制)

If Range("H" & LSearchRow).Value > Now() AND _
  Range("H" & LSearchRow).Value < Now() + 60 Then

对于简单的字符串连接,CStr转换并非完全必要。