Универсальный поиск по диапазону (переписать)

' Универсальная функция возврата даты
Function GetMes_New(r As Range) As String
Dim arr(12)  As String
Dim adress1 As Integer
arr(0) = "январь"
arr(1) = "февраль"
arr(2) = "март"
arr(3) = "апрель"
arr(4) = "май"
arr(5) = "июнь"
arr(6) = "июль"
arr(7) = "август"
arr(8) = "сентябрь"
arr(9) = "октябрь"
arr(10) = "ноябрь"
arr(11) = "декабрь"


For i = 0 To UBound(arr, 1)
  If Not r.Find(arr(i)) Is Nothing Then
     GetMes_New = (arr(i)) & " " & GetMY(r.Find(arr(i)).Value, (arr(i)))
     Exit For
  End If
Next i
'r.Find(arr(i)).Value
End Function


Function GetMY(r As String, cr As String)
Dim arr() As String
arr() = Split(r)
For i = 0 To UBound(arr)
  arr(i) = arr(i)

If StrConv(arr(i), vbLowerCase) = StrConv(cr, vbLowerCase) Then
   mes = arr(i + 1)
'   god = arr(i + 1)
End If
Next i
GetMY = mes & " " & god
End Function


Function RangeF(r As Range)
  For Each xl In r
   Debug.Print xl.Value
    If Len(xl.Value) > 0 And Len(GetMes_New(xl.Value)) > 0 Then
       RangeF = GetMY(xl.Value, "за")
       Debug.Print xl.Value
       Exit Function
    End If
'      ddddfdfdf = delcr(xl, "за")
  Next
End Function

Добавить комментарий

Ваш адрес email не будет опубликован. Обязательные поля помечены *