В экселе в во вкладке данные можно при проверке данных сделать, чтобы при нажатию на ячейку вплывало сообщение с нужным текстом. А если допустим для каждой ячейки этот текст разный и их очень много, то как можно этот текст допустим с другого листа брать? Т.е. допустим на листе 1 будет в первом столбце перечень уникальное имя, в остальных столбцах какие то другие значения для этого уникального имени. На листе 2 так же будет в столбце 1 этот же перечень уникальных имен, а во втором столбце краткое описание этого имени. Хотелось бы, если на листе 1 при наведении или выделении ячейки с уникальным именем появлялось его описание, которое будет браться с лист 2
В экселе в во вкладке данные можно при проверке данных сделать, чтобы при нажатию на ячейку вплывало сообщение с нужным текстом. А если допустим для каждой ячейки этот текст разный и их очень много, то как можно этот текст допустим с другого листа брать? Т.е. допустим на листе 1 будет в первом столбце перечень уникальное имя, в остальных столбцах какие то другие значения для этого уникального имени. На листе 2 так же будет в столбце 1 этот же перечень уникальных имен, а во втором столбце краткое описание этого имени. Хотелось бы, если на листе 1 при наведении или выделении ячейки с уникальным именем появлялось его описание, которое будет браться с лист 2ovechkin1973
Плохо когда не знаешь, да еще забудешь. Правильно сформулированный вопрос содержит половину ответа.
Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim d_ As Range c_ = 1 r0_ = 2 n_ = Cells(Rows.Count, c_).End(3).Row - r0_ + 1 Set d_ = Intersect(Target(1), Cells(r0_, c_).Resize(n_)) If Not d_ Is Nothing Then Cells(r0_, c_).Resize(n_).Validation.Delete On Error Resume Next With d_.Validation .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator:=xlBetween .InputTitle = "Описание" With Sheets("Лист2") c1_ = 1 r01_ = 2 n1_ = .Cells(.Rows.Count, c1_).End(3).Row - r01_ + 1 im_ = WorksheetFunction.VLookup(d_, .Cells(r01_, c1_).Resize(n1_, 2), 2, 0) End With .InputMessage = im_ End With End If End Sub
[/vba]
Такой вариант в модуль листа [vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim d_ As Range c_ = 1 r0_ = 2 n_ = Cells(Rows.Count, c_).End(3).Row - r0_ + 1 Set d_ = Intersect(Target(1), Cells(r0_, c_).Resize(n_)) If Not d_ Is Nothing Then Cells(r0_, c_).Resize(n_).Validation.Delete On Error Resume Next With d_.Validation .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator:=xlBetween .InputTitle = "Описание" With Sheets("Лист2") c1_ = 1 r01_ = 2 n1_ = .Cells(.Rows.Count, c1_).End(3).Row - r01_ + 1 im_ = WorksheetFunction.VLookup(d_, .Cells(r01_, c1_).Resize(n1_, 2), 2, 0) End With .InputMessage = im_ End With End If End Sub
_Boroda_, Вы профессор экселя! Спасибо! Кучу времени на поиске в инете чего то похожего потратил.. нашел только то, что приложил. Тоже наверно кому то пригодится.. но ваш вариант просто супер. Буду прилаживать его к своему файлу.
_Boroda_, Вы профессор экселя! Спасибо! Кучу времени на поиске в инете чего то похожего потратил.. нашел только то, что приложил. Тоже наверно кому то пригодится.. но ваш вариант просто супер. Буду прилаживать его к своему файлу.ovechkin1973
Private Sub Worksheet_SelectionChange(ByVal Target As Range) On Error Resume Next With Target.Validation .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator:=xlBetween .InputTitle = "Описание" .InputMessage = WorksheetFunction.VLookup(Target, Worksheets(2).Columns("A:B"), 2, False) End With End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range) On Error Resume Next With Target.Validation .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator:=xlBetween .InputTitle = "Описание" .InputMessage = WorksheetFunction.VLookup(Target, Worksheets(2).Columns("A:B"), 2, False) End With End Sub