Question

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

我试过了：

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

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

Answer 1

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

使用Find方法无法执行此操作。您必须在列中的每个单元格中创建循环。

Answer 2

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

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这样的可疑编码实践。 TBH，一旦你知道就在那里，application.Match就可以轻松找到它。

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

2 个答案: