Добрый день, господа экселисты! Нигде не могу найти решение задачи. Как реализовать автозавершение ввода в ячейке исходя из списка имеющихся значений на другом листе.
Добрый день, господа экселисты! Нигде не могу найти решение задачи. Как реализовать автозавершение ввода в ячейке исходя из списка имеющихся значений на другом листе.Мурад
Спасибо, Александр! Да, постараюсь разобраться. Видел это решение, когда занимался поиском. Но продолжал искать, надеясь на более простое решение, без использования макросов)
Спасибо, Александр! Да, постараюсь разобраться. Видел это решение, когда занимался поиском. Но продолжал искать, надеясь на более простое решение, без использования макросов)Мурад
Сообщение отредактировал Мурад - Четверг, 04.10.2018, 17:28
Что я неправильно сделал, можете помочь? хочу изменить блок вызова модуля поиска по клику на ячейку b2
[vba]
Код
Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Range <> ("B2") Then Exit Sub If Target.Range = ("B2") Then ufrmNilem.Show End Sub
[/vba]
Что я неправильно сделал, можете помочь? хочу изменить блок вызова модуля поиска по клику на ячейку b2
[vba]
Код
Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Range <> ("B2") Then Exit Sub If Target.Range = ("B2") Then ufrmNilem.Show End Sub
Разобрался и с этим. Остался последний) Модуль зашит в листе 2, с этого листа идет вызов. Если я копирую лист 2, то с нового листа 3 вызов уже не работает. Пробовал скопировать код [vba]
Код
Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Column = 2 And Target.Row = 2 Then ufrmNilem.Show 'If Target.Count <> 10 Then Exit Sub End Sub
[/vba] в книгу, но оттуда вызов не работает((
Разобрался и с этим. Остался последний) Модуль зашит в листе 2, с этого листа идет вызов. Если я копирую лист 2, то с нового листа 3 вызов уже не работает. Пробовал скопировать код [vba]
Код
Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Column = 2 And Target.Row = 2 Then ufrmNilem.Show 'If Target.Count <> 10 Then Exit Sub End Sub
[/vba] в книгу, но оттуда вызов не работает((Мурад
Доброе утро! Спасибо, Александр! Понял, почему у меня не копировался макрос при копировании листа. Надо было просто перенести код вызова формы на лист шаблона))
Доброе утро! Спасибо, Александр! Понял, почему у меня не копировался макрос при копировании листа. Надо было просто перенести код вызова формы на лист шаблона))Мурад
Не знаю, в продолжение этой же темы или надо создавать другую. Если на одном листе в ячейке B2 создан макрос вызова формы поиска из списка значений, то как сделать на этом же листе в диапазоне A2:A40 вызов такой же формы, но с поиском по другому списку значений? Начал с того, что задаю вызов формы поиска либо с ячейки B2, либо с диапазона A22:A40 [vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim r, r1, r2 As Range Set r1 = Range("B2") Set r2 = Range("A22:A40") Set r = Union(r1, r2) If Intersect(Target, Range(r)) Is Nothing Then Exit Sub ufrmNilem.Show End Sub
[/vba] И поскольку руки у меня кривые, эксель послал меня к черту, написав, что так делать нельзя)
Не знаю, в продолжение этой же темы или надо создавать другую. Если на одном листе в ячейке B2 создан макрос вызова формы поиска из списка значений, то как сделать на этом же листе в диапазоне A2:A40 вызов такой же формы, но с поиском по другому списку значений? Начал с того, что задаю вызов формы поиска либо с ячейки B2, либо с диапазона A22:A40 [vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim r, r1, r2 As Range Set r1 = Range("B2") Set r2 = Range("A22:A40") Set r = Union(r1, r2) If Intersect(Target, Range(r)) Is Nothing Then Exit Sub ufrmNilem.Show End Sub
[/vba] И поскольку руки у меня кривые, эксель послал меня к черту, написав, что так делать нельзя)Мурад
Сообщение отредактировал Мурад - Пятница, 05.10.2018, 10:49
Параллельно корректирую код формы, чтобы при выборе ячейки B2 срабатывал один цикл, а при клике по диапазону A22:A40 - другой: [vba]
Код
Option Explicit Option Compare Text Dim x, y
Private Sub UserForm_Initialize() With Worksheets("basa") x = .Range("C210", .Cells(Rows.Count, 3).End(xlUp)).Value '' адрес 1 базы y = .Range("N2", .Cells(Rows.Count, 14).End(xlUp)).Value '' адрес 2 базы End With End Sub
Private Sub TextBox1_Change() Dim i As Long, s As String, txt As String, lt As Long
txt = TextBox1.Text: lt = Len(txt) If lt = 0 Then s = "" '' Else For i = 1 To UBound(x, 1) If InStr(x(i, 1), txt) Then s = s & "~" & x(i, 1) Next i For i = 1 To UBound(y, 1) If InStr(y(i, 1), txt) Then s = s & "~" & y(i, 1) Next i End If Me.ListBox1.List = Split(Mid(s, 2), "~") End Sub
Private Sub ListBox1_Click() If ListBox1.ListIndex = -1 Then Exit Sub Me.Label4.Caption = Me.ListBox1.Value End Sub
Private Sub CommandButton1_Click() Dim o1 As Worksheet
ActiveCell.Value = Me.Label4.Caption
Unload Me End Sub
[/vba] При такой корректировке кода, логично, что 2 базы у меня объединились)) и будут предлагаться к выбору значения из 2 баз при клике на ячейке B2
Параллельно корректирую код формы, чтобы при выборе ячейки B2 срабатывал один цикл, а при клике по диапазону A22:A40 - другой: [vba]
Код
Option Explicit Option Compare Text Dim x, y
Private Sub UserForm_Initialize() With Worksheets("basa") x = .Range("C210", .Cells(Rows.Count, 3).End(xlUp)).Value '' адрес 1 базы y = .Range("N2", .Cells(Rows.Count, 14).End(xlUp)).Value '' адрес 2 базы End With End Sub
Private Sub TextBox1_Change() Dim i As Long, s As String, txt As String, lt As Long
txt = TextBox1.Text: lt = Len(txt) If lt = 0 Then s = "" '' Else For i = 1 To UBound(x, 1) If InStr(x(i, 1), txt) Then s = s & "~" & x(i, 1) Next i For i = 1 To UBound(y, 1) If InStr(y(i, 1), txt) Then s = s & "~" & y(i, 1) Next i End If Me.ListBox1.List = Split(Mid(s, 2), "~") End Sub
Private Sub ListBox1_Click() If ListBox1.ListIndex = -1 Then Exit Sub Me.Label4.Caption = Me.ListBox1.Value End Sub
Private Sub CommandButton1_Click() Dim o1 As Worksheet
ActiveCell.Value = Me.Label4.Caption
Unload Me End Sub
[/vba] При такой корректировке кода, логично, что 2 базы у меня объединились)) и будут предлагаться к выбору значения из 2 баз при клике на ячейке B2Мурад
Это уже похоже на единицу мне за незнание элементарного синтаксиса Но так и есть) А как разделить в коде выше базу данных для B2 (x) и базу данных для A22:A40 (y)? Уверен, это многим пригодится.
Это уже похоже на единицу мне за незнание элементарного синтаксиса Но так и есть) А как разделить в коде выше базу данных для B2 (x) и базу данных для A22:A40 (y)? Уверен, это многим пригодится.Мурад
Ох, Александр, пришлось попотеть. Целый час ковырялся, искал в инете, пробовал. И получилось, наконец-то. Все работает, списки выводятся независимо: [vba]
Код
Option Explicit Option Compare Text Dim x, y
Private Sub UserForm_Initialize() With Worksheets("basa") x = .Range("C210", .Cells(Rows.Count, 3).End(xlUp)).Value '' адрес 1 базы y = .Range("N2", .Cells(Rows.Count, 14).End(xlUp)).Value '' адрес 2 базы End With End Sub
Private Sub TextBox1_Change() Dim i As Long, j As Long, s1 As String, s2 As String, txt As String, lt As Long
txt = TextBox1.Text: lt = Len(txt) If lt = 0 Then s1 = "" '''при отсутствии символов для поиска обнуляем ListBox s2 = "" '''при отсутствии символов для поиска обнуляем ListBox Else For i = 1 To UBound(x, 1) 'поиск по любому вхождению If InStr(x(i, 1), txt) Then s1 = s1 & "~" & x(i, 1) Next i For j = 1 To UBound(y, 1) 'поиск по любому вхождению If InStr(y(j, 1), txt) Then s2 = s2 & "~" & y(j, 1) Next j End If If Not Intersect(ActiveCell, Range("B2")) Is Nothing Then Me.ListBox1.List = Split(Mid(s1, 2), "~") ElseIf Not Intersect(ActiveCell, Range("A22:A40")) Is Nothing Then Me.ListBox1.List = Split(Mid(s2, 2), "~") End If End Sub
Private Sub ListBox1_Click() If ListBox1.ListIndex = -1 Then Exit Sub Me.Label4.Caption = Me.ListBox1.Value End Sub
Private Sub CommandButton1_Click() Dim o1 As Worksheet
ActiveCell.Value = Me.Label4.Caption
Unload Me End Sub
[/vba]
Ох, Александр, пришлось попотеть. Целый час ковырялся, искал в инете, пробовал. И получилось, наконец-то. Все работает, списки выводятся независимо: [vba]
Код
Option Explicit Option Compare Text Dim x, y
Private Sub UserForm_Initialize() With Worksheets("basa") x = .Range("C210", .Cells(Rows.Count, 3).End(xlUp)).Value '' адрес 1 базы y = .Range("N2", .Cells(Rows.Count, 14).End(xlUp)).Value '' адрес 2 базы End With End Sub
Private Sub TextBox1_Change() Dim i As Long, j As Long, s1 As String, s2 As String, txt As String, lt As Long
txt = TextBox1.Text: lt = Len(txt) If lt = 0 Then s1 = "" '''при отсутствии символов для поиска обнуляем ListBox s2 = "" '''при отсутствии символов для поиска обнуляем ListBox Else For i = 1 To UBound(x, 1) 'поиск по любому вхождению If InStr(x(i, 1), txt) Then s1 = s1 & "~" & x(i, 1) Next i For j = 1 To UBound(y, 1) 'поиск по любому вхождению If InStr(y(j, 1), txt) Then s2 = s2 & "~" & y(j, 1) Next j End If If Not Intersect(ActiveCell, Range("B2")) Is Nothing Then Me.ListBox1.List = Split(Mid(s1, 2), "~") ElseIf Not Intersect(ActiveCell, Range("A22:A40")) Is Nothing Then Me.ListBox1.List = Split(Mid(s2, 2), "~") End If End Sub
Private Sub ListBox1_Click() If ListBox1.ListIndex = -1 Then Exit Sub Me.Label4.Caption = Me.ListBox1.Value End Sub
Private Sub CommandButton1_Click() Dim o1 As Worksheet