Excel VBA: Макрос для преобразования текста

[iva]

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

Макрос должен преобразовать строки, которые заканчиваются ".jpg", остальные строки не надо обрабатывать.
Нужно оставить текст, от последнего правого слеша до расширения и ещё нужно преобразовать, используя знаки "_" и числа, как показано ниже.

Примеры исходного текста:
......./aaa.jpg
........./bbbb_sdfgsfg_afgsfgaa_y.jpg
............../ccccc_1_axlssghs_alfjaa_slssa.jpg
........../dddddd_2_pe_аbааwertаaa_pr.jpg

Результат (должен быть в соседнем столбце):
aaa
bbbb
ccccc/1
dddddd/2

[Администратор]

Макрос работает со столбцом A, вставляет результат в столбец B.
Предполагается, что первая строка - это шапка, а данные начинаются со строки 2.

Макрос

Sub макрос()

    Dim arr(), res(), instr_ As Long
    Dim var, lr As Long, i As Long
   
   
    '1. Копирование столбца A в массив. С массивом макрос быстрее работает, чем с объектами.
    ' Поиск последней строки в столбце A. End не ищет в скрытых строках.
    lr = Cells(Rows.Count, "A").End(xlUp).Row
    ' Данные копируются со строки 2, т.к. предполагается, что в строке 1 шапка.
    arr() = Range("A2:A" & lr).Value
   
    '2. Создание ячеек в массиве-результате. Сначала в него запишутся данные,
        ' а затем массив будет вставлен в эксель. Это ускорит макрос.
    ReDim res(1 To UBound(arr, 1), 1 To 1)
   
    '3. Заполнение массива-результата.
    For i = 1 To UBound(arr, 1)
       
        '1) Нужно работать со строками, у которых на конце ".jpg".
        If LCase(Right(arr(i, 1), 4)) <> ".jpg" Then
            GoTo metka_NextRow
        End If
       
        '2) Поиск слеша.
        instr_ = InStrRev(arr(i, 1), "/")
        '3) Запись в переменную фрагмента от последнего слеша и до конца ячейки.
        var = Mid(arr(i, 1), instr_ + 1)
        '4) Удаление с конца расширения.
        ' Поиск расширения.
        instr_ = InStrRev(var, ".")
        ' Удаление расширения.
        var = Left(var, instr_ - 1)
        '5) Разбивка на части по символам "_".
        var = Split(var, "_")
        '6) Запись первой части в массив-результат.
        res(i, 1) = var(0)
        '7) Запись второй части, если она является числом.
        If UBound(var) > 0 Then
            If IsNumeric(var(1)) Then
                res(i, 1) = res(i, 1) & "/" & var(1)
            End If
        End If
       
metka_NextRow:
    Next i
   
    '4. Вставка массива-результата в эксель в столбец B.
    Range("B2").Resize(UBound(res, 1)).Value = res()
   
    '5. Сообщение.
    MsgBox "Готово.", vbInformation

End Sub

[свернуть]

[iva]

Работает. Большое спасибо!