Перерывы «.Dind Date» в середине месяца

Question

Я использую функцию, чтобы найти ячейку, которая соответствует дате за 6 дней до текущей выбранной. Он отлично работает для всех дат «после» 15 числа месяца. До 15 числа месяца это ломается ....? Кто-нибудь знает почему? это моя вина как-то?

Вот код, который я использую:

Private Function FindUpperDateCellAddress(stringUpperDate) As Range

Set FindUpperDateCellAddress = Range("D:D").Find(stringUpperDate, LookAt:=xlWhole, LookIn:=xlValues)


If FindUpperDateCellAddress Is Nothing Then
'Do nothing
MsgBox "Sorry, I have not been able to find an upper cell address.", vbCritical, "Oops"
End
Else
upperBoundCellAddress = FindUpperDateCellAddress.Address

End If


End Function

Чтобы объяснить немного больше. Мне нужен адрес ячейки с датой за 6 дней до того, который я использую. Они не отстают последовательно, но могут быть разделены 50 или более рядами.

Я пытался использовать дату в качестве строки, в качестве даты, переформатировать ее, переформатировать сам лист, чтобы убедиться, что ячейка является ячейкой даты.

Примечание. поиск генерируется с помощью формулы в ячейке. Таким образом, ячейка не является датой.

Спасибо.

Answer 1

Другой способ избежать использования метода .Find состоит в том, чтобы l oop пройти через ваш диапазон, чтобы найти данные.

Я также указал диапазон вместо поиска по всему столбцу, найдя LastRow как последнюю использованную строку и использовав ее в нашей инструкции Set для диапазона.

Private Function FindUpperDateCellAddress(ByVal stringUpperDate As String) As Range

Dim RangeToSearch As Range
Dim CellToSearch As Range
Dim LastRow As Long
Dim convertedDate As Date

convertedDate = CDate(stringUpperDate)

LastRow = Cells(Rows.Count, 4).End(xlUp).Row
Set RangeToSearch = Range("D1:D" & LastRow) 

'This searches from Cell D1 to the last used Cell in column D
For Each CellToSearch In RangeToSearch
    If CellToSearch.Value = convertedDate Then
        Set FindUpperDateCellAddress = CellToSearch
        Exit For
    Else
        'Do nothing
    End If
Next CellToSearch

If FindUpperDateCellAddress Is Nothing Then
    MsgBox "Sorry, I have not been able to find an upper cell address.", vbCritical, "Oops"
    Exit Function
End If
End Function

Answer 2

Вы на правильном пути, но некоторый синтаксис вашей функции немного не в порядке.

Рассмотрите возможность переписывания следующим образом:

Private Function FindUpperDateCellAddress(ByVal stringUpperDate As String) As Range

Dim upperBoundCellAddress As String
Dim RangeToSearch As Range

Set RangeToSearch = Range("D:D").Find(stringUpperDate, LookAt:=xlWhole, LookIn:=xlValues)


If RangeToSearch Is Nothing Then
    'Do nothing
    MsgBox "Sorry, I have not been able to find an upper cell address.", vbCritical, "Oops"
    Exit Function
Else
    upperBoundCellAddress = RangeToSearch.Address
End If

Set FindUpperDateCellAddress = Sheet1.Range(upperBoundCellAddress)
End Function

И вызовите его из подпрограммы, например:

Sub TestDate()

Dim myDate As Range

Set x = FindUpperDateCellAddress("14/04/2020")

Debug.Print "The date found was: " & x.Value
Debug.Print "The Address found was: " & x.Address

End Sub

Это найдет "14/04/2020" в Column D на Sheet на основании приведенных ниже данных на листе.

ПРИМЕЧАНИЕ: это будет только находить дату как String, означая, что она найдет ее, только если дата записана как текстовое значение, а не как значение даты. См. Ниже в этом примере порядок поиска значения даты.

На основании данных этого примера будет напечатано следующее в окно непосредственного доступа VBE:

The date found was: 14/04/2020
The Address found was: $D$14

Для тех же результатов, но при поиске значения date, измените его на функцию:

Dim convertedDate As Date

convertedDate = CDate(stringUpperDate)

Set RangeToSearch = Range("D:D").Find(convertedDate, LookAt:=xlWhole, LookIn:=xlValues)

Answer 3

Предполагая, что ваши даты являются "реальными" датами (и я предполагаю, что они таковы, поскольку, когда вы изменяете формат на общий, они меняются на число), возможно, наиболее надежный метод - это l oop через поиск значений рассматриваемая дата.

Обратите внимание, что мы используем свойство .Value2 объекта диапазона, поскольку это будет неформатированное значение.

Таким образом, код вашей функции может выглядеть следующим образом:

Option Explicit
Private Function FindUpperDateCellAddress(stringUpperDate As Date) As Range

    Dim C As Range
    Dim R As Range

With Worksheets("sheet1")
    Set R = .Range(.Cells(1, 4), .Cells(.Rows.Count, 4).End(xlUp))
End With

For Each C In R
    If Int(C.Value2) = Int(stringUpperDate) Then
        Set FindUpperDateCellAddress = C
        Exit Function
    End If
Next C

MsgBox "Sorry, I have not been able to find an upper cell address.", vbCritical, "Oops"

End Function

Вам может потребоваться внести некоторые изменения, если вы не используете Sheet1 или диапазон столбца D для своих данных.

Преобразование значений в целое число может не потребоваться в зависимости от как именно генерируются ваши реальные данные и real stringUpperDate

Также взгляните на мой ответ на Excel VBA Range.Find Date Это Формула