Тащусь с вайб-кодинга)))

Function ТекстВДату(текст As String) As Variant Dim части() As String Dim месяц As String Dim год As Integer Dim номерМесяца As Integer Dim месяцы As Variant Dim i As Integer

' Массив русских названий месяцев месяцы = Array("январь", "февраль", "март", "апрель", _ "май", "июнь", "июль", "август", _ "сентябрь", "октябрь", "ноябрь", "декабрь")

On Error GoTo Ошибка

' Разбиваем текст на части части = Split(текст, " ")

' Проверка формата If UBound(части) < 1 Then GoTo Ошибка

' Извлекаем месяц и год месяц = LCase(Trim(части(0))) год = Val(части(1))

' Проверка года If год < 1900 Or год > 9999 Then GoTo Ошибка

' Ищем номер месяца номерМесяца = 0 For i = 0 To 11 If месяцы(i) = месяц Then номерМесяца = i + 1 Exit For End If Next i

If номерМесяца = 0 Then GoTo Ошибка

' Возвращаем дату ТекстВДату = DateSerial(год, номерМесяца, 1) Exit Function

Ошибка: ТекстВДату = CVErr(xlErrValue) End Function