Новости:

Интересные и полезные статьи по работе с Excel и VBA можно найти в разделе ХИТРОСТИ

Главное меню

Названия месяцев между двумя датами

Автор Niyetkhan, 04.05.2016, 07:34:31

« назад - далее »

Niyetkhan

Задался мыслью я решить одну проблему,
Быть может, знает кто-нибудь такую тему:

     В общем, дело обстоит так. Есть начальная и конечная даты (например, 03.05.2016 и 08.08.2016, формат ДАТА). Нужно вывести последовательный список Названий месяцев между этими двумя датами (включая заданные даты): Май Июнь Июль Август. Название каждого месяца в отдельной ячейке в одной строке. Может, есть такая функция, но я не представляю себе, как ее задать. Лучше было, если бы был макрос, который в своем коде ссылаясь на эти 2 ячейки с начальной и конечной датами, выводил результат на определенную ячейку, начиная с которой отображался бы данный список.
    Файл прилагается.

    Буду признателен за любой отклик.

Юрий М

#1
См. вариант. Только я поменял местами даты начала и окончания. Если нужно оставить именно так, то нужно будет поменять код. Но принцип должен быть понятен. Проверку на то, что дата начала не может быть больше даты окончания, не делал - это уж сами добавьте )

Niyetkhan

Спасибо !!! Это именно то, что я хотел. Рад, что так быстро получил ответ.

Niyetkhan

Только один вопрос: скажите, как и где в коде VBA указываются нужные ячейки? Я имею в виду ячейки с датами и ячейку начала списка.

Юрий М

Вот комментарииSub Macro1()
Dim Counter As Long, DateStart As Date, DateFinish As Date
Dim Uniq As New Collection, i As Long, iCol As Long
    DateStart = Cells(2, 4) 'Начальная дата
    DateFinish = Cells(2, 7) 'Конечная дата
    Counter = DateFinish - DateStart 'Количество дней между датами
    ReDim Arr(1 To Counter, 1 To 2) 'Создали массив
    For i = 1 To Counter 'Цикл по массиву
        Arr(i, 1) = Month(DateStart) 'В первый столбец массива заносим номер месяца стартовой даты
        Select Case (Arr(i, 1)) 'Во второй столбец массива заносим названия месяца, в зависимости от его номера
            Case Is = 1: Arr(i, 2) = "Январь"
            Case Is = 2: Arr(i, 2) = "Февраль"
            Case Is = 3: Arr(i, 2) = "Март"
            Case Is = 4: Arr(i, 2) = "Апрель"
            Case Is = 5: Arr(i, 2) = "Май"
            Case Is = 6: Arr(i, 2) = "Июнь"
            Case Is = 7: Arr(i, 2) = "Июль"
            Case Is = 8: Arr(i, 2) = "Август"
            Case Is = 9: Arr(i, 2) = "Сентябрь"
            Case Is = 10: Arr(i, 2) = "Октябрь"
            Case Is = 11: Arr(i, 2) = "Ноябрь"
            Case Is = 12: Arr(i, 2) = "Декабрь"
        End Select
        DateStart = DateStart + 1 'Прибавили к стартовой дате один день
    Next
    For i = 1 To UBound(Arr) 'Отбираем в коллекцию уникальные имена месяцев
        On Error Resume Next
        Uniq.Add Arr(i, 2), CStr(Arr(i, 2))
    Next
    iCol = 4 'Номер столбца, с которого начнём вывод месяцев
    For i = 1 To Uniq.Count 'Цикл по коллекции уникальных значений (месяцев)
        Cells(4, iCol) = Uniq(i) 'Ячейка четвёртой строки с заданным номером столбца получает название месяца
        iCol = iCol + 1 'Увеличили номер столбца на единичку
    Next
End Sub

Niyetkhan