在VBA中查找与当前日期最接近的日期 [英] Find closest date to current date in VBA

问题描述

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

I am trying to create a macro that activates the first cell that is the current date or closest to it in a column.

我尝试过:

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

仅当当前日期在该列中的某个位置时才有效，但是如果不是，则我将收到错误消息.如何修改它以继续搜索，直到找到与当前日期最接近的日期?

Which works only if the current date is somewhere in the column, but if it is not then I get an error. How do I modify it to keep searching until it find the closest date to the current date?

推荐答案

过程的一小部分可以确定您要查找的日期，而不是循环地进行一系列对当前日期的加减运算.

Rather than looping through a progressive series of additions and subtractions to the current date, a short sub section of your procedure can determine the date that you are looking for.

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，一旦您知道在那里，一个应用程序.Match 可以很容易地找到它.

This is a passive way to determine the closest date. Once found, we know it is there and questionable coding practices like On Error Resume Next can be avoided. TBH, once you know is it there, an application.Match could locate it just as easily.

这篇关于在VBA中查找与当前日期最接近的日期的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！