检查日期是否介于某个范围之间

时间:2014-09-09 20:24:37

标签: excel vba excel-vba

我的数据类似于:

A1: ID
B1: Start date
C1: End Date

我有另一张

的工作表(称之为新)
A1: ID and 
B1: Date

我需要查看新工作表中ID的日期是否已在上一个工作表中。如果日期是开始日期,结束日期或介于两者之间的任何日期,我希望它显示已存在的记录。

3 个答案:

答案 0 :(得分:1)

此处的解决方案假设更实用:

  • 包含ID,开始日期,结束日期(多行)的主表单
  • 具有ID和日期(多行)的其他工作表
  • 使用用户定义函数(UDF)和ID单元格作为输入
  • 一个缺点是,如果其他工作表已更新,您将需要“计算工作表”

截图示例:
Sheet1 D2的公式:=FindDuplicates(A2)

Sheet1 Sheet2 Sheet3

模块中的代码:

Option Explicit

Function FindDuplicates(oRngID As Range) As String
    Dim sID As String, dStart As Date, dEnd As Date, lCount As Long, sWhere As String
    Dim oWS As Worksheet, oRngFound As Range, dFound As Date, sFirstFound As String

    sID = oRngID.Text
    dStart = oRngID.Offset(0, 1).Value
    dEnd = oRngID.Offset(0, 2).Value
    lCount = 0
    sWhere = ""
    For Each oWS In ThisWorkbook.Worksheets
        ' Find all IDs in other worksheeets
        If oWS.Name <> oRngID.Worksheet.Name Then
            sFirstFound = ""
            Set oRngFound = oWS.Cells.Find(What:=sID)
            If Not oRngFound Is Nothing Then
                sFirstFound = oRngFound.Address
                ' Keep searching until the first found address is met
                Do
                    ' Check the dates, only add if within the dates
                    dFound = oRngFound.Offset(0, 1).Value
                    If dStart <= dFound And dFound <= dEnd Then
                        lCount = lCount + 1
                        If lCount = 1 Then
                            sWhere = sWhere & lCount & ")  '" & oWS.Name & "'!" & oRngFound.Address
                        Else
                            sWhere = sWhere & vbCrLf & lCount & ")  '" & oWS.Name & "'!" & oRngFound.Address
                        End If
                    End If
                    Set oRngFound = oWS.Cells.Find(What:=sID, After:=oRngFound)
                Loop Until oRngFound.Address = sFirstFound
            End If
        End If
    Next
    If lCount = 0 Then sWhere = "Not Found"
    FindDuplicates = Replace(sWhere, "$", "") ' Removes the $ sign in Addresses
End Function

答案 1 :(得分:0)

所以,你有3个问题:

1)从另一个工作表中获取值:

Dim startDate As Date
startDate = ActiveWorkbook.worksheets("OtherSheetName").cells(row,col).Value

2)比较数据:

If startDate <= actualDate And actualDate <= endDate Then
    ...
Else
    ...
End If

3)设置单元格值:

ActiveWorkbook.worksheets("SheetName").cells(row,col).Value = something

结合这些步骤,您将获得解决问题的方法。

答案 2 :(得分:0)

我有点喜欢这个问题...

我这样做的方法是使用SUMPRODUCT()函数来检查多个条件(此网站上有很多参考资料,谷歌解释了它是如何工作的)

在您的New工作表中,假设第一行代表标题,请在单元格C2中输入以下公式:

=SUMPRODUCT(--(Sheet1!$A$2:$A$180=A2),--((B2-Sheet1!$B$2:$B$180)>=0),--((Sheet1!$C$2:$C$180-B2)>=0)) > 0

并将其向下拖动到整个范围(显然,调整180行参考以适合您的数据集)

基本上,你所说的是:

Give me a TRUE only if there is at least one row in my other sheet where:
 -  The IDs match
 -  [My Date] minus row's [Start date] >= 0
 -  Row's [End Date] - [My Date] >= 0

希望有意义!