День добрый, Мог бы кто-нибудь написать макрос для следующей задачи: при выборе необходимого пункта в выпадающем списке в колонке «Образец», выполнялось открытие необходимой ячейки на другом листе (в данном примере на «Схему»). Просмотрел все ранее предложенные варианты, но они осуществляют ссылку лишь на необходимый лист, а не на конкретную ячейку. Заранее спасибо!
День добрый, Мог бы кто-нибудь написать макрос для следующей задачи: при выборе необходимого пункта в выпадающем списке в колонке «Образец», выполнялось открытие необходимой ячейки на другом листе (в данном примере на «Схему»). Просмотрел все ранее предложенные варианты, но они осуществляют ссылку лишь на необходимый лист, а не на конкретную ячейку. Заранее спасибо!kostyan2638
Pelena, Да, мой вопрос был не точен. В новом приложенном файле на втором листе указаны ячейки, на которые необходимо ссылаться. То есть, выбираем в выпадающем списке необходимый пункт, он нас ссылает в соответствующую ячейку, указанную на втором листе.
Pelena, Да, мой вопрос был не точен. В новом приложенном файле на втором листе указаны ячейки, на которые необходимо ссылаться. То есть, выбираем в выпадающем списке необходимый пункт, он нас ссылает в соответствующую ячейку, указанную на втором листе.kostyan2638
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("c6:c65536")) Is Nothing Then u_1 = Target.Value u_2 = Application.Match("*" & u_1 & """", Sheets("Сусло ").Range("f:f"), 0) u_3 = Application.IsNumber(u_2) If u_3 Then Sheets("Сусло ").Select Sheets("Сусло ").Range("f" & u_2).Select End If End If End Sub
[/vba]
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("c6:c65536")) Is Nothing Then u_1 = Target.Value u_2 = Application.Match("*" & u_1 & """", Sheets("Сусло ").Range("f:f"), 0) u_3 = Application.IsNumber(u_2) If u_3 Then Sheets("Сусло ").Select Sheets("Сусло ").Range("f" & u_2).Select End If End If End Sub
Function x(R As Range) As Range Dim R1 As Range Set x = R With Application: .ScreenUpdating = 0: .EnableEvents = 0 With Application.Caller On Error GoTo er Set R1 = ['Сусло '!F:F].Find(.Value, , xlValues, xlPart) .Hyperlinks.Delete .Hyperlinks.Add .Cells, "", R1.Address(, , , 1) End With er: .ScreenUpdating = 1: .EnableEvents = 1: End With End Function
[/vba]
до кучи, вариант с UDF [vba]
Код
Function x(R As Range) As Range Dim R1 As Range Set x = R With Application: .ScreenUpdating = 0: .EnableEvents = 0 With Application.Caller On Error GoTo er Set R1 = ['Сусло '!F:F].Find(.Value, , xlValues, xlPart) .Hyperlinks.Delete .Hyperlinks.Add .Cells, "", R1.Address(, , , 1) End With er: .ScreenUpdating = 1: .EnableEvents = 1: End With End Function
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
