Можно убрать макросы со всех листов, а этот поместить в модуль книги: [vba]
Код
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) Dim arr(), lr As Long, i As Long If Sh.Name = "база" Then Exit Sub If Target.Column < 4 Or Target.Column > 5 Then Exit Sub If Target.Row < 7 Or Target.Row > 30 Then Exit Sub r = Target.Row: c = Target.Column Select Case Target.Column Case 4 lr = Sheets(1).Cells(Sheets(1).Rows.Count, "C").End(xlUp).Row arr() = Sheets(1).Range("C1:C" & lr).Value Case 5 lr = Sheets(1).Cells(Sheets(1).Rows.Count, "D").End(xlUp).Row arr() = Sheets(1).Range("D1:D" & lr).Value End Select UserForm1.ListBox2.Clear For i = 2 To UBound(arr) If arr(i, 1) <> "" Then UserForm1.ListBox2.AddItem arr(i, 1) End If Next i UserForm1.Show End Sub
[/vba]
Можно убрать макросы со всех листов, а этот поместить в модуль книги: [vba]
Код
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) Dim arr(), lr As Long, i As Long If Sh.Name = "база" Then Exit Sub If Target.Column < 4 Or Target.Column > 5 Then Exit Sub If Target.Row < 7 Or Target.Row > 30 Then Exit Sub r = Target.Row: c = Target.Column Select Case Target.Column Case 4 lr = Sheets(1).Cells(Sheets(1).Rows.Count, "C").End(xlUp).Row arr() = Sheets(1).Range("C1:C" & lr).Value Case 5 lr = Sheets(1).Cells(Sheets(1).Rows.Count, "D").End(xlUp).Row arr() = Sheets(1).Range("D1:D" & lr).Value End Select UserForm1.ListBox2.Clear For i = 2 To UBound(arr) If arr(i, 1) <> "" Then UserForm1.ListBox2.AddItem arr(i, 1) End If Next i UserForm1.Show End Sub
KuklP Согласен - не совсем правильно выразился... Не кнопка, а ФОРМА
Макрос на форме, позволяет вводить данные из базы в столбцы D и Е. Мне нужно, чтобы и на других листах я мог заполнять столбцы D и Е посредством формы.
KuklP Согласен - не совсем правильно выразился... Не кнопка, а ФОРМА
Макрос на форме, позволяет вводить данные из базы в столбцы D и Е. Мне нужно, чтобы и на других листах я мог заполнять столбцы D и Е посредством формы.grh1
Маленькое улучшение еще хотелось бы - я становлюсь в ячейку в столбце D, вставляю нужное (в форме данные столбца Сбазы) и тут-же перехожу в ячейку столбца Е чтобы вставить данные (в форме должны быть данные столбца Dбазы) а в форме еще данные столбца Сбазы. И мне приходится клацнуть мышкой где-нибудь сбоку потом опять в ту ячейку куда надо ввести данные и только после этих телодвижений в форме меняются данные на нужные. Можно что-нибудь с этим сделать?
Маленькое улучшение еще хотелось бы - я становлюсь в ячейку в столбце D, вставляю нужное (в форме данные столбца Сбазы) и тут-же перехожу в ячейку столбца Е чтобы вставить данные (в форме должны быть данные столбца Dбазы) а в форме еще данные столбца Сбазы. И мне приходится клацнуть мышкой где-нибудь сбоку потом опять в ту ячейку куда надо ввести данные и только после этих телодвижений в форме меняются данные на нужные. Можно что-нибудь с этим сделать?grh1
Private Sub ListBox1_Click() If ListBox1.ListCount > 0 And r * c > 0 Then Sheets(2).Cells(r, c) = ListBox1.List(ListBox1.ListIndex) Unload UserForm1 '.Hide End If End Sub
[/vba]
Цитата
Wasilich Вы ошиблись темой
Я ошибся файлом. Может уже и не надо, но он же есть, а вдруг понадобится.
Private Sub ListBox1_Click() If ListBox1.ListCount > 0 And r * c > 0 Then Sheets(2).Cells(r, c) = ListBox1.List(ListBox1.ListIndex) Unload UserForm1 '.Hide End If End Sub
Wasilich дело в том, что мне самому не нравится форма у меня в файле, но... Ваш вариант - для маленьких таблиц 7-10строк...
А у меня в файле их 4-5 тысяч строк и если не будет ячейки ввода и отсева, то можно будет чокнуться, пока найдешь нужное. Идеальный вариант, это как в Iphone5-6 поиск - вводишь любое слово и он по мере набора букв сужает диапазон поиска.
Wasilich дело в том, что мне самому не нравится форма у меня в файле, но... Ваш вариант - для маленьких таблиц 7-10строк...
А у меня в файле их 4-5 тысяч строк и если не будет ячейки ввода и отсева, то можно будет чокнуться, пока найдешь нужное. Идеальный вариант, это как в Iphone5-6 поиск - вводишь любое слово и он по мере набора букв сужает диапазон поиска.grh1