Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Перевести в ссылки весь диапазон
 
#1
21.06.2019 13:10:46
Добрый день!
Подскажите как сделать макрос, уже всю голову сломал:
На листе 1 в столбце E из имеющегося текста сделать гиперссылки на лист 2. Список в столбце будет очень длинный, соответственно нужно перевести в ссылки весь диапазон (исключая 1 строку и пустые ячейки).
То есть, на 1 листе вместо текста получить ссылки Телевизор1, Телевизор2... И при нажатии на ссылку Телевизор1, осуществляется переход на 2й лист.
Есть код, но он просто делает из списка гиперссылки без перехода, необходимо в код добавить адрес перехода
Код
Private Sub CreateHypelinkInTextCellv2()
    Dim iCell As Range, iText$
    For Each iCell In [E2:E15]
        iText = iCell.Text
        If iText <> "" Then iCell.Hyperlinks.Add iCell, iText
    Next
End Sub
Заранее всем спасибо за помощь.
Изменено: slider85 - 22.06.2019 19:06:34
 
 
 
#2
21.06.2019 15:46:54
Вариант:
Код
Sub CreateHypelinkInTextCellv2()
    Dim iCell As Range, iText$, sAddr
    For Each iCell In Worksheets("Лист1").[E2:E15]
        iText = iCell.Value
        If iText <> "" Then
        sAddr = Worksheets("Лист2").Range("C1:C10000").Find(What:=iText).Address
        iCell.Hyperlinks.Add anchor:=iCell, Address:="", SubAddress:="'" & "Лист2" & "'" & "!" & sAddr
        End If
    Next
End Sub
Изменено: _Igor_61 - 21.06.2019 15:51:14 (забыл файл прилепить :))
 
 
 
#3
21.06.2019 16:14:57
Да, все работает в файле, спасибо.
Но в свой переношу, там названия листов из двух слов с пробелом, подскажите как указать лист?
В этой строке ошибку выдает:
Код
sAddr = Worksheets("Хранение детали").Range("C1:C10000").Find(What:=iText).Address
Изменено: slider85 - 21.06.2019 17:55:52
 
 
 
#4
21.06.2019 16:22:39
файл покажите
 
 
 
#5
21.06.2019 16:32:41

Файл прикрепил. Спасибо за помощь!

Изменено: slider85 - 22.06.2019 19:07:09
 
 
 
#6
21.06.2019 16:47:57
Это уже совсем другой вопрос. Создайте новую тему с этим вопросом.
 
 
 
#7
21.06.2019 17:03:37
Ок, тогда этот вопрос вынесу в отдельную тему.
А что с по первому вопросу, поможете с моим последним файлом?
Изменено: slider85 - 21.06.2019 18:11:25
 
 
 
#8
21.06.2019 19:27:16
У Вас дело не в пробелах. Форматы ячеек должны быть одинаковыми. А ошибка в указанной строке появляется когда нет такого слова на втором листе, Find не может найти то, что нужно, тем более что во втором примере данные уже в другом столбце. Сделайте так:
Код
Sub CreateHypelink_1()
    Dim iCell As Range, sAddr
    Worksheets("Хранение").Activate
    Application.ScreenUpdating = False
    For Each iCell In Worksheets("Хранение").Range("E3:E110")
        On Error Resume Next
        If iCell.Value <> "" Then
           sAddr = Worksheets("Хранение детали").Range("E1:E1400").Find(What:=iCell.Value).Address
          If Err = 0 Then
             iCell.Hyperlinks.Add anchor:=iCell, Address:="", SubAddress:="'" & "Хранение детали" & "'!" & sAddr
          Else
             Err.Clear
          End If
        End If
    Next
    Application.ScreenUpdating = True
End Sub
И уберите пробелы между строк в 1-м и 5-м сообщениях, Вам же модератор про это сказал!
 
 
 
#9
21.06.2019 19:56:28
Спасибо огромное за помощь!
Все работает как надо :-)
 
 
 
Страницы: 1
Наверх