Поиск значений в базе по первым буквам при вводе на листе - Страница 2 - Мир MS Excel

Регистрация

Напомнить пароль

= Мир MS Excel/Поиск значений в базе по первым буквам при вводе на листе - Страница 2 - Мир MS Excel

Старая форма входа

Страница 2 из 3 « 1 2 3 »
Модератор форума: китин, _Boroda_

Поиск значений в базе по первым буквам при вводе на листе (Макросы/Sub)

Поиск значений в базе по первым буквам при вводе на листе

Дата: Среда, 11.10.2017, 12:21 | Сообщение № 21

Группа: Пользователи

Ранг: Прохожий

Сообщений: 4

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Может быть подскажете что нужно сделать что бы после того как значение найдено кроме самого найденного значения копировалась еще значение той же строки предидущего столбца и вставлялось так же в основной документ в предидущий столбец текущей строки ?

Ответить

Дата: Среда, 11.10.2017, 12:26 | Сообщение № 22

Группа: Админы

Ранг: Местный житель

Сообщений: 16711

Репутация: 6502 ±

Замечаний: ±

2003; 2007; 2010; 2013 RUS

Пожалуйста.
В этой теме не подскажу. Читайте Правила форума. Тем более, что у вас еще во фрилансе тема, на вопрос из которой вы так и не удосужились ответить

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995

Ответить

Дата: Среда, 11.10.2017, 12:39 | Сообщение № 23

Группа: Пользователи

Ранг: Прохожий

Сообщений: 4

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Как же не ответил. Я на почту файл скинул т.к. не удалось уменьшить файл до 100кб

Сообщение отредактировал dp - Среда, 11.10.2017, 12:41

Ответить

Дата: Суббота, 14.10.2017, 13:14 | Сообщение № 24

Группа: Пользователи

Ранг: Новичок

Сообщений: 24

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

_Boroda_,

Цитата _Boroda_, 10.10.2017 в 23:14, в сообщении № 20 ()

Первый Фор-Некст нужно закомментировать, а второй наоборот - раскомментировать

Здравствуйте! Попробовал сделать это для поиска номера авто по цифрам а не по первым буквам. Вроде закомментировал первый фор-некст, а а второй - раскомментировал.
Получилось так:
[vba]

Код

X = Range("B6", Cells(Rows.Count, 2).End(xlUp)).Value
'For i = 1 To UBound(X, 1)    ' поиск по первым буквам
'    If txt = Mid(X(i, 1), 1, lt) Then s = s & "~" & X(i, 1)
'Next i
For i = 1 To UBound(X, 1) 'поиск по любому вхождению
    If InStr(X(i, 1), txt) Then s = s & "~" & X(i, 1)
Next i
ListBox1.List = Split(Mid(s, 2), "~")
End Sub

[/vba]
Но при вводе цифр в форму поиска, пусто.
Что не так?

К сообщению приложен файл: 4709708.xlsm (43.3 Kb)

Сообщение отредактировал velikoleg - Суббота, 14.10.2017, 13:42

Ответить

Дата: Понедельник, 04.12.2017, 14:22 | Сообщение № 25

Группа: Пользователи

Ранг: Прохожий

Сообщений: 1

Репутация: 0 ±

Замечаний: 0% ±

Excel 2013

Добрый день уважаемые ГУРУ Excel. Есть вопрос по созданию combobox в форме, от которого будет зависеть диапазон значений, введенных в textbox. Есть производитель, есть оборудование. По первым буквам внесенным в textbox отображаются все варианты из столбца А1 листа basa. Хотелось бы сделать так.Как пример. При выборе производителя Neumo из combobox при наборе первых букв в textbox в listbox отображались только те варианты, которые относятся к Neumo. База данных постоянно пополняется как производителями, так и оборудованием

Сообщение отредактировал vlascha - Понедельник, 04.12.2017, 14:52

Ответить

Дата: Среда, 13.12.2017, 11:58 | Сообщение № 26

Группа: Пользователи

Ранг: Прохожий

Сообщений: 3

Репутация: 0 ±

Замечаний: 0% ±

Excel 2013

Добрый день, а возможно добавить еще несколько столбцов для поиска результатов? например 3,4,5?

Ответить

Дата: Среда, 13.12.2017, 13:28 | Сообщение № 27

Группа: Модераторы

Ранг: Старожил

Сообщений: 2290

Репутация: 766 ±

Замечаний: 0% ±

2019

Зачем дублировать сообщения?
Дубликаты удалил.

Цитата Лиза, 13.12.2017 в 11:58, в сообщении № 26 ()

еще несколько столбцов для поиска результатов? например 3,4,5?

замените столбцы в строке
[vba]

Код

Set r = Sheets("База данных").Columns("c:e").SpecialCells(2).Offset(1)

[/vba]
Здесь .Columns("c:e") = нужные Вам столбцы (3,4,5)

Иногда все проще чем кажется с первого взгляда.

Ответить

Дата: Четверг, 15.03.2018, 16:47 | Сообщение № 28

Группа: Пользователи

Ранг: Прохожий

Сообщений: 1

Репутация: 0 ±

Замечаний: 0% ±

Excel 2007

Здравствуйте! подскажите пожалуйста как изменить код чтобы значения в листбокс1 не повторялись, если в начальной базе есть ячейки с одинаковыми именами. Спасибо.
Например если много ивановых, то они все отображаются.

К сообщению приложен файл: 9847212.xlsm (27.9 Kb)

Сообщение отредактировал Tomatr - Четверг, 15.03.2018, 16:54

Ответить

Дата: Четверг, 15.03.2018, 20:15 | Сообщение № 29

Группа: Админы

Ранг: Местный житель

Сообщений: 19401

Репутация: 4549 ±

Замечаний: ±

Excel 365 & Mac Excel

Tomatr, прочитайте Правила форума и создайте свою тему

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816

Ответить

Дата: Среда, 06.06.2018, 20:53 | Сообщение № 30

Группа: Пользователи

Ранг: Прохожий

Сообщений: 1

Репутация: 0 ±

Замечаний: 0% ±

Excel 2016

что нужно сделать чтобы работать только клавиатурой без мышки, т.е. из листбокса в текстбокс с помощью стрелок клавиатуры и клавиши enter?

Сообщение отредактировал zic000 - Среда, 06.06.2018, 21:09

Ответить

Дата: Четверг, 07.06.2018, 10:15 | Сообщение № 31

Группа: Авторы

Ранг: Старожил

Сообщений: 1161

Репутация: 103 ±

Замечаний: 0% ±

Excel 2010

zic000, 1) почитать правила, Pelena прямо над Вашим постом написала, что. 2) удалено администрацией

Интуитивно понятный код - это когда интуитивно понятно, что это код.

Ответить

Дата: Четверг, 07.06.2018, 12:40 | Сообщение № 32

Группа: Пользователи

Ранг: Прохожий

Сообщений: 3

Репутация: 0 ±

Замечаний: 0% ±

Excel 2016

Добрый день!
А если запускать поиск в ячейке нужно по двойному клику, как исправить код?
Или нужно новую тему создать?
Спасибо!

Ответить

Дата: Четверг, 07.06.2018, 12:58 | Сообщение № 33

Группа: Авторы

Ранг: Старожил

Сообщений: 1161

Репутация: 103 ±

Замечаний: 0% ±

Excel 2010

Lan1,

Цитата Lan1, 07.06.2018 в 12:40, в сообщении № 32 ()

Или нужно новую тему создать?

Интуитивно понятный код - это когда интуитивно понятно, что это код.

Ответить

Дата: Вторник, 13.11.2018, 13:26 | Сообщение № 34

Группа: Пользователи

Ранг: Прохожий

Сообщений: 2

Репутация: 0 ±

Замечаний: 0% ±

Excel 2016

Большое спасибо за такое решение! Под себя подстроил, но - на защищенном листе - ругается, предлагает разобраться со строкой
[vba]

Код

x = Columns(153).SpecialCells(2).Offset(1).Value

[/vba]
Предлагает убрать защиту и не париться.
Но если лист хотелось бы очень иметь защищенным?
Ячейки указанного диапазона не защищены

Сообщение отредактировал feaf - Вторник, 13.11.2018, 15:18

Ответить

Дата: Вторник, 13.11.2018, 13:37 | Сообщение № 35

Группа: Админы

Ранг: Местный житель

Сообщений: 16711

Репутация: 6502 ±

Замечаний: ±

2003; 2007; 2010; 2013 RUS

- Прочитайте Правила форума
- Оформите код тегами (в режиме правки поста выделите код и нажмите кнопку #, пояснялка здесь)
Вариантов несколько, нужно смотреть файл

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995

Ответить

Дата: Вторник, 13.11.2018, 14:06 | Сообщение № 36

Группа: Пользователи

Ранг: Прохожий

Сообщений: 2

Репутация: 0 ±

Замечаний: 0% ±

Excel 2016

Под спойлер спрятать не получилось. Правки касались только выбора места куда и откуда что вставлять.
[vba]

Код

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 = 3 And Target.Row > 54 And Target.Row < 67 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(153).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

[/vba]

Под спойлер спрятать не получилось. Правки касались только выбора места куда и откуда что вставлять.
[vba]

Код

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 = 3 And Target.Row > 54 And Target.Row < 67 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(153).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

[/vba]feaf

Ответить

СообщениеПод спойлер спрятать не получилось. Правки касались только выбора места куда и откуда что вставлять.
[vba]

Код

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 = 3 And Target.Row > 54 And Target.Row < 67 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(153).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

[/vba]

Автор - feaf
Дата добавления - 13.11.2018 в 14:06

Дата: Вторник, 13.11.2018, 14:26 | Сообщение № 37

Группа: Админы

Ранг: Местный житель

Сообщений: 16711

Репутация: 6502 ±

Замечаний: ±

2003; 2007; 2010; 2013 RUS

Зачем под спойлер? Об этом разве в Правилах написано?
Еще раз - - Прочитайте Правила форума
- Оформите в своем первом сообщении код тегами (в режиме правки поста выделите код и нажмите кнопку #, пояснялка здесь)

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995

Ответить

Дата: Среда, 16.10.2019, 12:01 | Сообщение № 38

Группа: Пользователи

Ранг: Прохожий

Сообщений: 2

Репутация: 0 ±

Замечаний: 0% ±

Excel 2013

Ошибка: method or data member not found
На строчке: Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Что не так? Подскажите пожалуйста.

Ответить

Дата: Среда, 16.10.2019, 13:31 | Сообщение № 39

Группа: Проверенные

Ранг: Обитатель

Сообщений: 487

Репутация: 86 ±

Замечаний: 0% ±

Excel 2013

Цитата q81, 16.10.2019 в 12:01, в сообщении № 38 ()

Что не так? Подскажите пожалуйста.

Доброго дня!
чтобы на это ответить, надо видеть ваш код и желательно в вашем файле

Благими намерениями выстелена дорога в АД.

Ответить

Дата: Среда, 16.10.2019, 14:19 | Сообщение № 40

Группа: Пользователи

Ранг: Прохожий

Сообщений: 2

Репутация: 0 ±

Замечаний: 0% ±

Excel 2013

Цитата K-SerJC, 16.10.2019 в 13:31, в сообщении № 39 ()

Доброго дня!
чтобы на это ответить, надо видеть ваш код и желательно в вашем файле

Так происходит с любым файлом данного скрипта. Со всеми примерами по данной теме.

Ответить

Поиск значений в базе по первым буквам при вводе на листе (Макросы/Sub)

Страница 2 из 3
«
1
2
3
»

© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!