Excel - найти последний день месяца в диапазоне, заданном конкретным значением года и месяца

Question

Мне интересно, какие функции Excel / VBA я могу использовать, чтобы найти последний день месяца в диапазоне с определенными значениями ввода года и месяца. Например, с «1995» и «3» он должен возвращать «31.03.1995». С '1995' и '4' он должен возвращать '4/28/1995'.

Обратите внимание, что фактическим последним днем ​​'04/1995' было '30.04.1995'. Я ищу последний день в диапазоне «28.04.1995», поэтому я не могу просто слепо использовать функцию EOMONTH.

Answer 1

Другой метод может быть следующим: я не полностью протестировал, но это может быть пищей для размышлений.

Function get_latest_date(rngInput As Excel.Range, intMonth As Integer, lngYear As Long) As Date

get_latest_date = 0

On Error Resume Next

get_latest_date = Application.Evaluate( _
                "=MAX(IF((YEAR(" & _
                rngInput.Address & _
                ")=" & lngYear & _
                ")*(MONTH(" & _
                rngInput.Address & _
                ")=" & intMonth & ")," & rngInput.Address & "))")

End Function

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

У меня есть фиктивные даты, в общей сложности 10 000, с 2015 по 2030 год. Я провел быстрый тест, используя приведенный ниже

Function test_get_last_date()

Dim r As Excel.Range
Dim lYear As Long
Dim iMonth As Integer
Dim dTimer As Double

Set r = Range("a1:a10000")

dTimer = Timer

For lYear = 2015 To 2030

    For iMonth = 1 To 12

        Debug.Print get_latest_date(r, iMonth, lYear), "Took : "; Timer - dTimer
        dTimer = Timer

    Next iMonth

Next lYear


End Function

Это дало эти результаты

31/05/2017    Took :  0.02734375 
30/06/2017    Took :  0.015625 
31/07/2017    Took :  0.015625 
31/08/2017    Took :  0.015625 
30/09/2017    Took :  0.01953125

Answer 2

У вас есть 2 варианта:

1. Ваши данные отсортированы, и вы можете использовать совпадение с 1 или -1 третьим вариантом. Как говорится в комментарии Даррена Бартруп-Кука

2. В противном случае вам нужно добавить 2 столбца формулы для сортировки вашего решения:

Столбец B, формула=year(A:A)&MONTH(A:A);объединить ваши критерии

столбец C, формула из ячейки C2 =IFERROR(MAX((B$1:B1=B2)*(C$1:C1)),A2);затем разверните формулу вниз

Последнее значение в столбце C для каждого уникального месяца в столбце B будет вашими ответами. Вы можете извлечь результаты в столбце D с формулой из ячейки D2 =MAX(IF(B:B=B2,C2));затем разверните формулу вниз

Answer 3

Ниже приведено решение VBA, которое должно работать и быть относительно быстрым.

Я добавляю все элементы в диапазоне, которые соответствуют году и месяцу, в ArrayList. Затем я сортирую этот список по возрастанию и выбираю последний элемент в списке (этот элемент должен иметь наибольшее значение в наборе).

Это выполняется менее чем за секунду, просматривая списококоло 800 наименований.

Функция:

Option Explicit

Public Function MaxDateInRange(SearchRange As Range, _
                               YearNumber As Long, _
                               MonthNumber As Long) As String
    Dim cell        As Range
    Dim ListIndex   As Long
    Dim List        As Object: Set List = CreateObject("System.Collections.ArrayList")

    'Go thorugh all cells, and all items that match the month and year to a list
    For Each cell In SearchRange
        If IsDate(cell) Then
            If Month(cell) = MonthNumber And Year(cell) = YearNumber Then List.Add (cell)
        End If
    Next

    'Sort the list ascending, then select the last item in that list
    List.Sort
    ListIndex = List.Count - 1

    'Bounds check, to see if anything was found, otherwise return ""
    If ListIndex >= 0 Then
        MaxDateInRange = List(ListIndex)
    Else
        MaxDateInRange = vbNullString
    End If

End Function

Использование:

Public Sub Example()
    Dim rng As Range: Set rng = Sheets(2).Range("D1:D795")
    Dim t   As Double
    t = Timer

    Debug.Print MaxDateInRange(rng, 2019, 3)
    Debug.Print MaxDateInRange(rng, 2019, 4)

    Debug.Print "Process took " & Timer - t
End Sub

Отладочный выводпо данным выборки:

2019-03-28
2019-04-25
Process took 0.04296875