Поиск в базе данных vba excel

   Sashagerych, набросайте какой-нибудь примерчик для поиска по книге. На форуме попробуем порешать, и, если получится что-то стоящее, положим сюда.

   Так и сделаю
Правда сам я в VBA только на пальцах считать умею, так что могу сделать примитивный примерчик с пояснениями как я это вижу

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

+1
 

   Можно
Например используйте событие MouseMove

   Я и макрос то запустить не могу. Выдает object required на строке If ListBox1.ListIndex

   это название листа или обьект некий ? может где есть описание как применить данный макрос к книге ?

0
 

   А файл скачать Вы не пробовали? это же ГОТОВОЕ РЕШЕНИЕ!

   разобрался. спасибо ) Теперь надо с событием MouseMoe разобраться

0
 

   Заменил файл-пример: на 3-м листе есть разновидность поиска с встроенными полем и списком.
Кстати, если есть желание, давайте попробуем сделать красивую надстройку? (понадобятся пожелания/хотелки и время для тестирования)

   Ок, давайте хотелки :), и… где будем общаться?

   Доброго времени суток.
действительно хорошая вещь. Для своей работы мне пригодиться Sheet1 и ENTRY
Есть вопросы, на которые очень прошу ответить.
1. Для Sheet1 где поменять номер столбца? Например у меня необходимо брать данные из столбца 5 или Е.
2.Для ENTRY мне не нужно заполнять массив, а просто в ячейке ввести первые буквы, поиск должен выдать варианты.
С ёкселем чуть-чуть дружу, а вот с макросами, ни как не получается.
Если необходимо, могу скинуть свой файл.
Заранее благодарен.

   Здрасьте. По п.1 вместо
x = Range(«A1», Cells(Rows.Count, 1).End(xlUp)).Value
напишите
x = Range(«E1», Cells(Rows.Count, 5).End(xlUp)).Value

А в Sub ListBox1_Click() вместо
Columns(1).Find(ListBox1, lookat:=xlWhole).Select
нужно будет
Columns(5).Find(ListBox1, lookat:=xlWhole).Select

По п.2 не очень понятно. Наверное, лучше задать вопрос на форуме. Здесь ведь только «приемчики», а реализация м.б. какой угодно.

   Добрый день! Гуру не подскажут как сделать так, чтобы поиск был не по первым буквам, а по любым в строке. Например есть ячейка с текстом 0,75ВИНО ВАЛЛЕФЬОРИ РОСС КР СХ, и мне надо ее найти по слову вино или слову валл

   Здравствуйте!
Очень интересный код,
интересует как можно его переделать так, чтобы можно было сделать следующее:
Есть база данных (предположим на диапазоне ячеек А2:B7)
Я хочу производить поиск по диапазону А2:А7, но при выборе выводить значения из диапазона В2:В7
Так же поисковую форму я хочу, например, поставить на ячейки в диапазоне F2:F4 и G8:G10, а выводить значения в диапазон ячеек K2:K4 и K8:K10 соответственно
Я знаю, что можно эту задачу решить используя элементы ActiveX, но хотелось бы это сделать с помощью данного кода, самому опыта не хватает переделать ваш код, такое можно сделать?
Заранее спасибо

   Доброго времени суток. Подскажите пожалуйста, каким образом можно производить поиск по нескольким столбцам массива и выводить результат тоже из нескольких столбцов, а не с одного?

   Привет, Станислав
попробуйте так
Private Sub TextBox1_Change()
Dim x, v, txt As String, lt As Long, s As String
txt = TextBox1.Text: lt = Len(TextBox1.Text)
If lt = 0 Then Exit Sub
‘ будем искать в столбцах A:D
x = Range(«A1:D» & Cells(Rows.Count, 1).End(xlUp).Row).Value
For Each v In x ‘ поиск по первым буквам
If txt = Mid(v, 1, lt) Then s = s & «~» & v
Next i
‘For Each v In x ‘поиск по любому вхождению
‘ If InStr(v, txt) Then s = s & «~» & v
‘Next i
ListBox1.List = Split(Mid(s, 2), «~»)
End Sub

Private Sub ListBox1_Click()
If ListBox1.ListIndex = -1 Then Exit Sub
Range(«A:D»).Find(ListBox1, lookat:=xlWhole).Select
End Sub

   Спасибо nilem!
Но не совсем получается. ListBox находиться в UserForm, и данные я вывожу на несколько колонок
ListBox1.ColumnCount = 11
ListBox1.ColumnWidths = «50;40;140;140;140;140;40;40;40;40;40»

А макрос у меня сейчас работает так:

Private Sub TextBox1_Change()
Dim txt$, i&, j&, ii&, n&, xx
txt = TextBox1.Text
ii = 1
With ListBox1
.Clear
If Len(txt) = 0 Then .List = x: Exit Sub
ReDim xx(1 To UBound(x, 1), 1 To UBound(x, 2))
For i = 1 To UBound(x)
For j = 2 To 6
If InStr(1, x(i, j), txt) Then
xx(ii, 1) = x(i, 1)
xx(ii, 2) = x(i, 2)
xx(ii, 3) = x(i, 3)
xx(ii, 4) = x(i, 4)
xx(ii, 5) = x(i, 5)
xx(ii, 6) = x(i, 6)
xx(ii, 7) = x(i, 7)
xx(ii, = x(i,
xx(ii, 9) = x(i, 9)
xx(ii, 10) = x(i, 10)
xx(ii, 11) = x(i, 11)
ii = ii + 1
Exit For
End If
Next j
Next i
.List = xx
For i = .ListCount — 1 To 0 Step -1
If .List(i, 0) = 0 Then .RemoveItem i
Next
End With
End Sub

Работает довольно быстро (Вы как-то давали пример данного поиска). Но просто для эксперимента пытался сделать быстрее взял из этой статьи пример nerv и сделал поиск:

Private Sub TextBox1_Change()
Dim txt$, t
Dim ADO As New ADO
Dim Arr As Variant
t = Timer
txt = TextBox1.Text
With ListBox1
.Clear
If Len(txt) = 0 Then .List = x: Exit Sub
ADO.Query («SELECT F1, F2, F3, F4, F5, F6, F7, F8 » _
& «FROM [Где_Искать$A2:H] » _
& «WHERE » _
& «F1 LIKE » & «‘%» & txt & «%'» _
& » Or F2 LIKE » & «‘%» & txt & «%'» _
& » Or F3 LIKE » & «‘%» & txt & «%'» _
& » Or F4 LIKE » & «‘%» & txt & «%'» _
& » Or F5 LIKE » & «‘%» & txt & «%'» _
& » Or F6 LIKE » & «‘%» & txt & «%'» _
& » Or F7 LIKE » & «‘%» & txt & «%'» _
& » Or F8 LIKE » & «‘%» & txt & «%'» _
)

Arr = ADO.ToArray()
If IsEmpty(Arr) Then
.Clear
Else
.List = Arr
End If
End With
Debug.Print Timer — t
End Sub

Работает, но все же стандартными функции VBA работают быстрее

   Лучше бы, конечно, на форуме это обсудить, чтобы не загромождать «приемчик»

   Доброго времени суток. Подскажите пожалуйста как изменить код в листе ENTRY для ввода данных с другого листа. Спасибо.

   Добрый день, может кто помочь где я что не так делаю
Option Explicit
Option Compare Text
Dim bu As Boolean

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
If Target.Row = 1 Then Me.TextBox1.Visible = False: Me.ListBox1.Visible = False: Exit Sub
If Target.Column = 2 Then
bu = True
With Me.TextBox1
.Top = Target.Top: .Text = Target.Value ‘: .Activate
End With
With Me.ListBox1
.Top = Target.Top + 5
If (.Top + .Height + ActiveWindow.PointsToScreenPixelsY(0) * Application.InchesToPoints(1) * 15 / 1440) > _
(ActiveWindow.Application.Height + ActiveWindow.Application.Top) Then _
.Top = .Top — .Height + Target.Height ‘* ActiveWindow.Zoom / 100
.Clear
End With
bu = False
Me.TextBox1.Visible = True: Me.ListBox1.Visible = True
Else
Me.TextBox1.Visible = False: Me.ListBox1.Visible = False
End If
End Sub

Private Sub TextBox1_Change()
If Len(TextBox1.Text) = 0 Or bu Then Exit Sub ‘при отсутствии символов для поиска — выход
Dim x, i As Long, txt As String, lt As Long, s As String
txt = TextBox1.Text: lt = Len(TextBox1.Text)
x = Columns(32).SpecialCells(2).Offset(1).Value
For i = 1 To UBound(x, 1) ‘ поиск по первым буквам
If txt = Mid(x(i, 1), 1, lt) Then s = s & x(i, 1) & «~»
Next i
ListBox1.List = Split(s, «~»)
End Sub

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 13 Or KeyCode = 9 Then
With Me.TextBox1
ActiveCell.Value = .Value
.Visible = False: ListBox1.Visible = False
End With
ActiveCell(2, 1).Select
End If
End Sub

Private Sub ListBox1_Click()
If ListBox1.ListIndex = -1 Then Exit Sub
Application.EnableEvents = False
bu = True
With Me.ListBox1
ActiveCell.Value = .Value
Me.TextBox1.Text = .Value
Me.TextBox1.Visible = False: .Visible = False
End With

Application.EnableEvents = True
bu = False
End Sub

‘Sub tt()
‘Application.EnableEvents = True
‘End Sub

никак не могу заставить работать

   Спасибо, разобрался, только как данные с другого листа брать пока не понимаю.

   А все таки: что поменять, что бы база располагалась на другом листе? способ ENTRYYY

   Присоединяюсь к вопросу — нужно что бы данные брались с другого листа (способ ENTRY). Как сделать?

• Path.zip (25.75 КБ)

• Пример.xlsx (12.02 КБ)

• Path.zip (28.82 КБ)

• Пример.zip (27.17 КБ)