Страницы

понедельник, 3 февраля 2020 г.

Зеркальная дата – загадываем желание. VBA, Excel

Контент-менеджеры социальных сетей не устают удивлять. На этот раз попался пост о зеркальной дате, которая встречается всего раз в сто лет.

Зеркальная дата 02.02.2020 Не забудь загадать желание

Понятно, что таких дат не одна. В текущем столетии их будет ровно 29, поскольку в феврале может быть максимум 29 дней. Почему февраль? Возьмем 21 век, перевернем строку, две последних цифры года покажут месяц (2010 – 0102). Давайте составим расписание дней, в которые нужно загадывать желания. Используем MS Excel, а саму функцию напишем на VBA.

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

Составим вложенные  циклы. Внешний цикл – по годам от 2001 до 2092 (дальше нет смысла, так как всего 29 дней), внутренний – по дням от 1 до 29. Если счетчик равен 29, то нужно проверить, не високосный ли год. Месяц всегда февраль, поэтому цикл по нему в данном случае не нужен. Если бы мы делали расписание на тысячелетие, то пришлось бы еще добавлять и цикл по месяцам.

Проходим по циклам, получая год и день, месяц и так известен. Из полученных значений сформируем строку даты strDate, затем значения дня, месяца и двух последних цифр года по отдельности перевернем и сформируем «зеркальную» дату. Точнее не все перевернутые строки будут являться датами, поэтому нужно это дополнительно проверить с помощью функции IsDate(strDate). Если строка может быть датой, сравниваем ее с исходной датой. Если строки совпали, выводим полученную дату в ячейку рабочего листа. Номер строки будем считать отдельно.

Опишу использованные функции и операторы:

  • Number1 Mod number2 – возвращает остаток от деления первого числа (number1) на второе.
  • Exit For – выход из вложенного цикла.
  • IIf(арг1, арг2, арг3) – если первый аргумент – истина, то функция вычислит выражение во втором аргументе и вернет его значение. Если значение выражения в первом аргументе – ложь, то будет вычисляться выражение из третьего аргумента.
  • CStr(arg) – преобразование значения аргумента в строку.
  • StrReverse(str) – переворачивает строку, то есть возвращает строку, в которой порядок символов в указанной строке изменяется на обратный.
  • IsDate(arg) – проверка корректности даты. Возвращает истину, если аргумент может быть датой.
  • StrComp(arg1, arg2) – функция сравнения строк, возвращает 1, 0 и -1. Если 0, то строки равны. 
  • Cells(indexRow, indexColumn) – значение в ячейке строки indexRow и столбца indexColumn.

Текст функции ЗеркальнаяДата():
Public Sub ЗеркальнаяДата()
Dim strD As String 'день
Dim strM As String 'месяц
Dim strFeb As String 'февраль
Dim strY As String 'год
'счетчики для циклов
Dim i As Integer
Dim j As Integer
Dim strDate As String 'дата
Dim reverseDate As String 'зеркальная дата
Dim mod4 As Integer 'остаток от деления на 4 (для определения високосного года)
Dim numberRow As Integer 'номер строки для вывода даты на лист
strFeb = "02"
numberRow = 1
For i = 2001 To 2092
    For j = 1 To 29
        strM = strFeb
        'проверка високосного года
        If j = 29 Then
            mod4 = i Mod 4
            'не делится на 4, значит год не високосный, выход из итерации цикла
            If mod4 <> 0 Then
                Exit For
            End If
        End If
        'если число меньше 10, добавим впереди него 0
        strD = IIf(j < 10, "0" + CStr(j), CStr(j))
        strY = CStr(i)
        'формируем дату
        strDate = strD + "." + strM + "." + strY
        'переворачиваем день и месяц, чтобы собрать зеркальную дату
        strD = StrReverse(strD)
        strM = StrReverse(strM)
        'от года берем только две последние цифры. Если год меньше 2010,
        'то добавим впереди 0. Полученное число переворачиваем
        strY = StrReverse(IIf(i < 2010, "0" + CStr(i - 2000), CStr(i - 2000)))
        'собираем зеркальную дату
        reverseDate = strY + "." + strFeb + "." + strM + strD
        'если полученная строка - дата
        If IsDate(reverseDate) Then
            'то сравним исходную дату и перевернутую
            If StrComp(strDate, reverseDate) = 0 Then
                'если строки равны, то выведем дату на лист
                Cells(numberRow, 1) = strDate
                'перейдем на следующую строку на листе
                numberRow = numberRow + 1
            End If
        End If
    Next j
Next i
End Sub
Запустим функцию, нажав на зеленый треугольник на панели инструментов или нажав F5. В первом столбце листа видим список из 29 значений дат.


Список дат:

10.02.2001
20.02.2002
01.02.2010
11.02.2011
21.02.2012
02.02.2020
12.02.2021
22.02.2022
03.02.2030
13.02.2031
23.02.2032
04.02.2040
14.02.2041
24.02.2042
05.02.2050
15.02.2051
25.02.2052
06.02.2060
16.02.2061
26.02.2062
07.02.2070
17.02.2071
27.02.2072
08.02.2080
18.02.2081
28.02.2082
09.02.2090
19.02.2091
29.02.2092

Если переделать функцию на следующий век, то загадать желание в зеркальную дату можно 31 раз. Затем долгий перерыв до 3000 года.