Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Из представленных данных создать ссылку - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Из представленных данных создать ссылку (Макросы/Sub)
Из представленных данных создать ссылку
wwizard Дата: Воскресенье, 18.12.2016, 02:31 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 176
Репутация: 0 ±
Замечаний: 40% ±

Есть большой прайс лист. из 25ти заполненых колонок. Это товары поставщика. Нужно вставить в прайс ссылки на фото. Начиная с колонки 40, по колонку 47.
Прошу помощи в написании небольшого макроса.
Есть алгоритм, формирования ссылки на фотографии., а именно: URL картинки формируется исходя из кода товара.
http://brain.com.ua/static/images/prod_img/Предпоследний символ кода/Последний символ кода/Код товара_big.jpg;

Пример
Код товара: U0002094
URL: http://brain.com.ua/static/images/prod_img/9/4/U0002094_big.jpg

Т.е. по факту путь: http://brain.com.ua/static/images/prod_img/ - остается неизменным.
С кода товара - U0002094 - берутся две последние цифры, это подпапки, - 9/4/
Дальше полный код товара - U0002094

Первая колонка, вся эта ссылка заканчивается на: _big.jpg
Вторая: _2big.jpg
Третья: _3big.jpg
Четвертая: _4big.jpg
Пятая: _5big.jpg
Шестая: _6big.jpg
Седьмая: _7big.jpg
Восьмая: _8big.jpg

Возможно ли помочь мне в написании скрипта, бо формулами это очень долго делается?
Пример файла приложен. Заполнен результат как должно получиться в 3й и 4й строке, колонок 40-47. Там же прописаны формулы с помощью которых это делается.
К сообщению приложен файл: brain-proba.xlsx (14.1 Kb)


Сообщение отредактировал wwizard - Воскресенье, 18.12.2016, 02:40
 
Ответить
СообщениеЕсть большой прайс лист. из 25ти заполненых колонок. Это товары поставщика. Нужно вставить в прайс ссылки на фото. Начиная с колонки 40, по колонку 47.
Прошу помощи в написании небольшого макроса.
Есть алгоритм, формирования ссылки на фотографии., а именно: URL картинки формируется исходя из кода товара.
http://brain.com.ua/static/images/prod_img/Предпоследний символ кода/Последний символ кода/Код товара_big.jpg;

Пример
Код товара: U0002094
URL: http://brain.com.ua/static/images/prod_img/9/4/U0002094_big.jpg

Т.е. по факту путь: http://brain.com.ua/static/images/prod_img/ - остается неизменным.
С кода товара - U0002094 - берутся две последние цифры, это подпапки, - 9/4/
Дальше полный код товара - U0002094

Первая колонка, вся эта ссылка заканчивается на: _big.jpg
Вторая: _2big.jpg
Третья: _3big.jpg
Четвертая: _4big.jpg
Пятая: _5big.jpg
Шестая: _6big.jpg
Седьмая: _7big.jpg
Восьмая: _8big.jpg

Возможно ли помочь мне в написании скрипта, бо формулами это очень долго делается?
Пример файла приложен. Заполнен результат как должно получиться в 3й и 4й строке, колонок 40-47. Там же прописаны формулы с помощью которых это делается.
Автор - wwizard
Дата добавления - 18.12.2016 в 02:31
Karataev Дата: Воскресенье, 18.12.2016, 10:09 | Сообщение № 2
Группа: Проверенные
Ранг: Старожил
Сообщений: 1334
Репутация: 533 ±
Замечаний: 0% ±

Excel
[vba]
Код
Sub Сформировать_урлы()

    Dim arr(), arrRes(), strURL As String, strFragm As String
    Dim lr As Long, i As Long, j As Long
    
    Application.ScreenUpdating = False
    
    strURL = Range("AD1").Value
    
    lr = Cells(Rows.Count, "B").End(xlUp).Row
    If lr = 2 Then
        ReDim arr(1 To 1, 1 To 1)
        arr(1, 1) = Range("B2").Value
    Else
        arr() = Range("B2:B" & lr).Value
    End If
    ReDim arrRes(1 To UBound(arr), 1 To 8)
    
    For i = 1 To UBound(arr)
        strFragm = strURL & Mid(Right(arr(i, 1), 2), 1, 1) & "/" & Right(arr(i, 1), 1) & "/" & arr(i, 1)
        arrRes(i, 1) = strFragm & "_big.jpg"
        For j = 2 To UBound(arrRes, 2)
            arrRes(i, j) = strFragm & "_" & j & "big.jpg"
        Next j
    Next i
    
    Range("AN2").Resize(UBound(arrRes), UBound(arrRes, 2)).Value = arrRes()
    
    Application.ScreenUpdating = True

End Sub
[/vba]
 
Ответить
Сообщение[vba]
Код
Sub Сформировать_урлы()

    Dim arr(), arrRes(), strURL As String, strFragm As String
    Dim lr As Long, i As Long, j As Long
    
    Application.ScreenUpdating = False
    
    strURL = Range("AD1").Value
    
    lr = Cells(Rows.Count, "B").End(xlUp).Row
    If lr = 2 Then
        ReDim arr(1 To 1, 1 To 1)
        arr(1, 1) = Range("B2").Value
    Else
        arr() = Range("B2:B" & lr).Value
    End If
    ReDim arrRes(1 To UBound(arr), 1 To 8)
    
    For i = 1 To UBound(arr)
        strFragm = strURL & Mid(Right(arr(i, 1), 2), 1, 1) & "/" & Right(arr(i, 1), 1) & "/" & arr(i, 1)
        arrRes(i, 1) = strFragm & "_big.jpg"
        For j = 2 To UBound(arrRes, 2)
            arrRes(i, j) = strFragm & "_" & j & "big.jpg"
        Next j
    Next i
    
    Range("AN2").Resize(UBound(arrRes), UBound(arrRes, 2)).Value = arrRes()
    
    Application.ScreenUpdating = True

End Sub
[/vba]
Автор - Karataev
Дата добавления - 18.12.2016 в 10:09
Nic70y Дата: Воскресенье, 18.12.2016, 11:16 | Сообщение № 3
Группа: Друзья
Ранг: Экселист
Сообщений: 8761
Репутация: 2273 ±
Замечаний: 0% ±

Excel 2010
Цитата wwizard, 18.12.2016 в 02:31, в сообщении № 1 ()
это очень долго делается?
да вроде не долго
Код
= ГИПЕРССЫЛКА("http://brain.com.ua/static/images/prod_img/"&ПСТР($B2;7;1)&"/"&ПРАВСИМВ($B2; 1)&"/"&$B2&"_"&ЕСЛИ(СТОЛБЕЦ(A1)=1;"";СТОЛБЕЦ(A1))&"big.jpg";СТОЛБЕЦ(A1))
К сообщению приложен файл: 3806963.xlsx (13.9 Kb)

ЮMoney 41001841029809
 
Ответить
Сообщение
Цитата wwizard, 18.12.2016 в 02:31, в сообщении № 1 ()
это очень долго делается?
да вроде не долго
Код
= ГИПЕРССЫЛКА("http://brain.com.ua/static/images/prod_img/"&ПСТР($B2;7;1)&"/"&ПРАВСИМВ($B2; 1)&"/"&$B2&"_"&ЕСЛИ(СТОЛБЕЦ(A1)=1;"";СТОЛБЕЦ(A1))&"big.jpg";СТОЛБЕЦ(A1))
Автор - Nic70y
Дата добавления - 18.12.2016 в 11:16
wwizard Дата: Понедельник, 19.12.2016, 00:21 | Сообщение № 4
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 176
Репутация: 0 ±
Замечаний: 40% ±

Цитата Nic70y, 18.12.2016 в 11:16, в сообщении № 3 ()
да вроде не долго


Так надо, не 1,2,3,4,5 - а чтобы результат гиперссылки был прописан в ячейке.
 
Ответить
Сообщение
Цитата Nic70y, 18.12.2016 в 11:16, в сообщении № 3 ()
да вроде не долго


Так надо, не 1,2,3,4,5 - а чтобы результат гиперссылки был прописан в ячейке.
Автор - wwizard
Дата добавления - 19.12.2016 в 00:21
Nic70y Дата: Понедельник, 19.12.2016, 09:15 | Сообщение № 5
Группа: Друзья
Ранг: Экселист
Сообщений: 8761
Репутация: 2273 ±
Замечаний: 0% ±

Excel 2010
ну так в конце формулы уберите
Код
;СТОЛБЕЦ(A1)
и все

ЮMoney 41001841029809
 
Ответить
Сообщениену так в конце формулы уберите
Код
;СТОЛБЕЦ(A1)
и все
Автор - Nic70y
Дата добавления - 19.12.2016 в 09:15
wwizard Дата: Среда, 21.12.2016, 01:23 | Сообщение № 6
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 176
Репутация: 0 ±
Замечаний: 40% ±

Цитата Karataev, 18.12.2016 в 10:09, в сообщении № 2 ()
Sub Сформировать_урлы()


Скажите, а можно так, чтобы это с ячейки AD1: http://brain.com.ua/static/images/prod_img/
- уже было вписано в сам скрипт?
 
Ответить
Сообщение
Цитата Karataev, 18.12.2016 в 10:09, в сообщении № 2 ()
Sub Сформировать_урлы()


Скажите, а можно так, чтобы это с ячейки AD1: http://brain.com.ua/static/images/prod_img/
- уже было вписано в сам скрипт?
Автор - wwizard
Дата добавления - 21.12.2016 в 01:23
Karataev Дата: Среда, 21.12.2016, 08:15 | Сообщение № 7
Группа: Проверенные
Ранг: Старожил
Сообщений: 1334
Репутация: 533 ±
Замечаний: 0% ±

Excel
[vba]
Код
Sub Сформировать_урлы()

    Dim arr(), arrRes(), strURL As String, strFragm As String
    Dim lr As Long, i As Long, j As Long
    
    Application.ScreenUpdating = False
    
    strURL = "http://brain.com.ua/static/images/prod_img/"
    
    lr = Cells(Rows.Count, "B").End(xlUp).Row
    If lr = 2 Then
        ReDim arr(1 To 1, 1 To 1)
        arr(1, 1) = Range("B2").Value
    Else
        arr() = Range("B2:B" & lr).Value
    End If
    ReDim arrRes(1 To UBound(arr), 1 To 8)
    
    For i = 1 To UBound(arr)
        strFragm = strURL & Mid(Right(arr(i, 1), 2), 1, 1) & "/" & Right(arr(i, 1), 1) & "/" & arr(i, 1)
        arrRes(i, 1) = strFragm & "_big.jpg"
        For j = 2 To UBound(arrRes, 2)
            arrRes(i, j) = strFragm & "_" & j & "big.jpg"
        Next j
    Next i
    
    Range("AN2").Resize(UBound(arrRes), UBound(arrRes, 2)).Value = arrRes()
    
    Application.ScreenUpdating = True

End Sub
[/vba]
 
Ответить
Сообщение[vba]
Код
Sub Сформировать_урлы()

    Dim arr(), arrRes(), strURL As String, strFragm As String
    Dim lr As Long, i As Long, j As Long
    
    Application.ScreenUpdating = False
    
    strURL = "http://brain.com.ua/static/images/prod_img/"
    
    lr = Cells(Rows.Count, "B").End(xlUp).Row
    If lr = 2 Then
        ReDim arr(1 To 1, 1 To 1)
        arr(1, 1) = Range("B2").Value
    Else
        arr() = Range("B2:B" & lr).Value
    End If
    ReDim arrRes(1 To UBound(arr), 1 To 8)
    
    For i = 1 To UBound(arr)
        strFragm = strURL & Mid(Right(arr(i, 1), 2), 1, 1) & "/" & Right(arr(i, 1), 1) & "/" & arr(i, 1)
        arrRes(i, 1) = strFragm & "_big.jpg"
        For j = 2 To UBound(arrRes, 2)
            arrRes(i, j) = strFragm & "_" & j & "big.jpg"
        Next j
    Next i
    
    Range("AN2").Resize(UBound(arrRes), UBound(arrRes, 2)).Value = arrRes()
    
    Application.ScreenUpdating = True

End Sub
[/vba]
Автор - Karataev
Дата добавления - 21.12.2016 в 08:15
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Из представленных данных создать ссылку (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!