如何创建循环以连续获取一系列单元格中的两个最新日期

时间:2019-04-15 15:01:53

标签: excel vba

我有一个代码可以遍历一个范围,以找出日期是否小于当前日期,以及是否清除该单元格以及它前面的两个单元格。但是我在获取代码然后遍历相同范围并找到两个最新日期并清除内容(如除最近两个日期之外的所有其他日期的第一个循环)方面遇到问题。由于我只是编码的新手,即使在某些在线站点的帮助下,我也无法使它正常工作。

这是我尝试回溯并找到两个最新日期的最新内容。

For Each cell In Range("Q2:Q1000")
        If cell.Value < cell.Offset(0, 3).Value Or cell.Offset(0, 
        6).Value Or 
        cell.Offset(0, 9).Value Or cell.Offset(0, 12).Value Or 
         cell.Offset(0,15).Value Then
       cell.ClearContents
       End If

       If cell = "" Then
       cell.Offset(, -1) = ""
       cell.Offset(, -2) = ""
       End If




Here is the code to find out if contents is more than 2 years old.



For Each cell In Range("Q2:Q1000")
        If cell.Value < (currentDate - 730) Then
        cell.ClearContents

       End If


       If cell = "" Then
       cell.Offset(, -1) = ""
       cell.Offset(, -2) = ""
       End If

Next

我认为我缺少一些简单的东西,但找不到它。

1 个答案:

答案 0 :(得分:1)

这里是一种清除日期早于两个最近日期的所有单元格的方法。假设您在Range("Q2:Q1000")中的值已正确格式化Date单元格:

Dim cel as Range

For CurRow = 2 to 1000
    'Find the 2nd most recent date:
    BeforeDate = Application.WorksheetFunction.Large(Range("Q" & CurRow & ",T" & CurRow & ",W" & CurRow & ",Z" & CurRow & ",AC" & CurRow & ",AF" & CurRow),2)

    For Each cel In Range("Q" & CurRow & ",T" & CurRow & ",W" & CurRow & ",Z" & CurRow & ",AC" & CurRow & ",AF" & CurRow)
        If cel.Value < BeforeDate Then
            cel.ClearContents
            cel.Offset(, -1) = ""
            cel.Offset(, -2) = ""
        End If
    Next cel
Next CurRow