在VBA中查找与当前日期最接近的日期

Question

我正在尝试创建一个宏来激活列中当前日期或最接近当前日期的第一个单元格。

我试过这个：

Cells.Find(What:=Date, After:=Range("B6"), LookIn:=xlFormulas, _
    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate

仅当当前日期位于列中的某个位置时才有效，但如果不是，则会出现错误。如何修改它以继续搜索，直到找到与当前日期最接近的日期？

Answer 1

程序的一小部分可以确定您要查找的日期，而不是循环执行一系列渐进的加法和减法到当前日期。

Sub nearest_date()
    Dim b As Range, lr As Long, iMaxDiff As Long, d As Long, fndDate

    With ActiveSheet  'set this worksheet properly!
        With .Range(.Cells(6, 2), .Cells(Rows.Count, 2).End(xlUp))
            iMaxDiff = Application.Min(Abs(Application.Max(.Cells) - Date), Abs(Date - Application.Min(.Cells)))
            For d = 0 To iMaxDiff
                If CBool(Application.CountIf(.Cells, Date + d)) Then
                    fndDate = Date + d
                    Exit For
                ElseIf CBool(Application.CountIf(.Cells, Date - d)) Then
                    fndDate = Date - d
                    Exit For
                End If
            Next d
            Set b = .Find(What:=fndDate, After:=Range("B6"), LookIn:=xlFormulas, _
                          LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                          MatchCase:=False, SearchFormat:=False)

            'do something with the closest date. I do NOT recommend using .Select for anything beyond demonstration purposes
            b.Select
        End With
    End With
End Sub

这是确定最近日期的被动方式。一旦找到，我们就知道它就在那里，并且可以避免像

On Error Resume Next

这样有问题的编码实践。说实话，一旦您知道在那里，

application.Match

就可以轻松找到它。

Answer 2

您必须循环并评估列中的每个其他日期（因为最接近的日期可能位于最远的单元格中）。假设该列中有两个同样“接近”的日期，您可以选择最近的一个（按单元格）。

使用

Find

方法无法做到这一点。您必须在列中的每个单元格中创建循环。

Answer 3

试试这个： 子选择器Datum() 单元格（应用程序.匹配（CLng（日期），范围（“A：A”），1），“A”）。选择 结束子