Выбор значения из выпадающего списка сгиперссылкой через м-с

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Mrzod

Дата: Четверг, 03.10.2019, 14:25 | Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 18

Репутация: 0 ±

Замечаний: 0% ±

Excel 2016

Здравствуйте. Помогите пожалуйста исправить макрос чтоб он заработал. Необходимо при выборе значения из выпадающего списка чтоб создавалась гиперссылка к этому же наименованию в листе 3. В документе набросал макрос, скажите в чем ошибки. Так же прошу подсказать, как прописать в макросе к каждому значению в выпадающем списке свою гиперссылку на лист 3. Спасибо огромное .

К сообщению приложен файл: 2_5235905767680.xlsm (19.1 Kb)

Ответить

Nic70y

Дата: Четверг, 03.10.2019, 16:35 | Сообщение № 2

Группа: Друзья

Ранг: Экселист

Сообщений: 9005

Репутация: 2369 ±

Замечаний: 0% ±

Excel 2010

Цитата Mrzod, 03.10.2019 в 14:25, в сообщении № 1 ()

скажите в чем ошибки

не в тот модуль макрос засунули,
ну и т.д.
[vba]

Код

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("i2:i65536")) Is Nothing Then
        Application.EnableEvents = False
        u_01 = Target.Value
        'u_02 = "Лист2"
        u_02 = "Лист3"
        'u_03 = Application.Match(u_01, Sheets(u_02).Range("a:a"), 0)
        'u_04 = "#" & u_02 & "!A" & u_03
        u_17 = Target.Row - 1
        u_04 = "#" & u_02 & "!A" & u_17
        '''u_05 = Application.IsNumber(u_03)
        '''If u_05 Then
            Range(Target.Address).Hyperlinks.Add Anchor:=Selection, Address:=u_04
        '''End If
        Application.EnableEvents = True
    End If
End Sub

[/vba]

К сообщению приложен файл: 0844092.xlsm (22.1 Kb)

ЮMoney 41001841029809

Ответить

nilem

Дата: Четверг, 03.10.2019, 16:42 | Сообщение № 3

Группа: Авторы

Ранг: Старожил

Сообщений: 1613

Репутация: 563 ±

Замечаний: 0% ±

Excel 2013, 2016

немного по-другому
[vba]

Код

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Column <> 9 Then Exit Sub

Dim r As Range
Set r = Sheets("Лист3").Columns(1).Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
If r Is Nothing Then Exit Sub

Me.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:=r.Address(, , xlA1, True), _
ScreenTip:="qweqwewwd", TextToDisplay:=Target.Value
End Sub

[/vba]
В модуль листа Лист1.

Яндекс.Деньги 4100159601573

Ответить

Mrzod

Дата: Четверг, 03.10.2019, 17:18 | Сообщение № 4

Группа: Пользователи

Ранг: Новичок

Сообщений: 18

Репутация: 0 ±

Замечаний: 0% ±

Excel 2016

Цитата Nic70y, 03.10.2019 в 16:35, в сообщении № 2 ()

скажите в чем ошибки
не в тот модуль макрос засунули,
ну и т.д.

Спасибо большое за помощь.
А можно исправить немного ваш макрос, чтоб при нажатии enter он создавал гиперрсылку в этой же ячейке а не следующей ?

Ответить

Mrzod

Дата: Четверг, 03.10.2019, 18:33 | Сообщение № 5

Группа: Пользователи

Ранг: Новичок

Сообщений: 18

Репутация: 0 ±

Замечаний: 0% ±

Excel 2016

Цитата nilem, 03.10.2019 в 16:42, в сообщении № 3 ()

немного по-другому

Вам так же большое спасибо. Такой же вопрос, как поправить макрос, чтоб при вводе значения (которое соответствует раскрывающемуся списку) значение не дублировалось в ячейке ниже и чтоб сохранялась гиперссылка в этой же ячейке.
Спасибо.

Ответить

nilem

Дата: Четверг, 03.10.2019, 18:39 | Сообщение № 6

Группа: Авторы

Ранг: Старожил

Сообщений: 1613

Репутация: 563 ±

Замечаний: 0% ±

Excel 2013, 2016

вместо Selection напишите Target
[vba]

Код

Me.Hyperlinks.Add Anchor:=Selection...

[/vba]
нужно так
[vba]

Код

Me.Hyperlinks.Add Anchor:=Target ...

[/vba]

Яндекс.Деньги 4100159601573

Ответить

Mrzod

Дата: Пятница, 04.10.2019, 11:02 | Сообщение № 7

Группа: Пользователи

Ранг: Новичок

Сообщений: 18

Репутация: 0 ±

Замечаний: 0% ±

Excel 2016

Цитата nilem, 03.10.2019 в 18:39, в сообщении № 6 ()

нужно так
Me.Hyperlinks.Add Anchor:=Target ...

Спасибо вам большое. Все прекрасно работает. А можно сделать так, чтобы если значение на листе 3 отсутствует, чтоб макрос его не подчеркивал и не выделял.
Еще если не сложно, то у меня там есть еще один макрос для листа 1, можно ли их заставить работать вместе?
Спасибо.

К сообщению приложен файл: 0844092-2-.xlsm (21.9 Kb)

Сообщение отредактировал Mrzod - Пятница, 04.10.2019, 11:02

Ответить

nilem

Дата: Пятница, 04.10.2019, 22:08 | Сообщение № 8

Группа: Авторы

Ранг: Старожил

Сообщений: 1613

Репутация: 563 ±

Замечаний: 0% ±

Excel 2013, 2016

попробуйте:
[vba]

Код

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
Select Case Target.Column
    Case 8
        Dim r As Range
        Set r = Sheets("Лист 3").Columns(1).Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
        If r Is Nothing Then Target.Hyperlinks.Delete: Exit Sub
        Me.Hyperlinks.Add Anchor:=Target, Address:="", SubAddress:=r.Address(, , xlA1, True), _
                          ScreenTip:="Особый контроль"
    Case 10
        Target(1, -5).Value = Date
End Select

End Sub

[/vba]

Яндекс.Деньги 4100159601573

Ответить

Mrzod

Дата: Понедельник, 07.10.2019, 12:10 | Сообщение № 9

Группа: Пользователи

Ранг: Новичок

Сообщений: 18

Репутация: 0 ±

Замечаний: 0% ±

Excel 2016

Цитата nilem, 04.10.2019 в 22:08, в сообщении № 8 ()

попробуйте:

Спасибо огромное! Теперь все работает как нужно. hands

Ответить

Выбор значения из выпадающего списка сгиперссылкой через м-с

Страница 1 из 1
1