Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

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

 

= Мир MS Excel/Поиск в Умной Талице через Юсэр Форм - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Поиск в Умной Талице через Юсэр Форм (Макросы/Sub)
Поиск в Умной Талице через Юсэр Форм
RomanCompass Дата: Суббота, 02.10.2021, 18:17 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 32
Репутация: 10 ±
Замечаний: 0% ±

Excel 2016
Здравствуйте !
У меня возник вопрос такой ,

Вопрос такой , есть Умная Таблица (типа клиентской базы) - заполнение ее через Юсэр Форм .
Данный Ф.И. клиента - номер Водительского удостоверения - номер Паспорта - номер Телефона и многое другое .
Хочу узнать как при наборе в Юсэр Форм осуществить поиск в Таблице данных если такие уже есть .
К сообщению приложен файл: NEW_PUBLIC_3xls.xlsm(122.0 Kb)
 
Ответить
СообщениеЗдравствуйте !
У меня возник вопрос такой ,

Вопрос такой , есть Умная Таблица (типа клиентской базы) - заполнение ее через Юсэр Форм .
Данный Ф.И. клиента - номер Водительского удостоверения - номер Паспорта - номер Телефона и многое другое .
Хочу узнать как при наборе в Юсэр Форм осуществить поиск в Таблице данных если такие уже есть .

Автор - RomanCompass
Дата добавления - 02.10.2021 в 18:17
Santtic Дата: Понедельник, 04.10.2021, 16:39 | Сообщение № 2
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 181
Репутация: 1 ±
Замечаний: 0% ±

Excel 2016
[vba]
Код


Dim aList()
Sub MakeList(ByVal Sour As Range, ByRef Dest As Object)
    Dim c As Range, n As Integer, aList()
    For Each c In Sour.Cells
        If Len(c.Value) > 0 Then
            n = n + 1
            ReDim Preserve aList(1 To n)
            aList(n) = c.Value
        End If
    Next c
    Dest.List = aList
End Sub ' эта часть убирает пустые значения из комбобоксов

Private Sub UserForm_Activate()
MakeList Sheets("data").Range("j2:j20"), ComboBox1 ' диапазон столбца записывается в комбобок, так же комбобокс ищет по первым буквам.
End Sub
[/vba]
этот код я подвязывал под свою форму, проходит инициализация данных при запуске формы, и они записываются в перечисленные комбобоксы.
Посмотрел код вашей формы. У вас там все расписано, и поски изаписи в комбобоксы. Сделайте по аналогии для необходимых текст боксов, заменив их комбами.


Сообщение отредактировал Santtic - Понедельник, 04.10.2021, 16:44
 
Ответить
Сообщение[vba]
Код


Dim aList()
Sub MakeList(ByVal Sour As Range, ByRef Dest As Object)
    Dim c As Range, n As Integer, aList()
    For Each c In Sour.Cells
        If Len(c.Value) > 0 Then
            n = n + 1
            ReDim Preserve aList(1 To n)
            aList(n) = c.Value
        End If
    Next c
    Dest.List = aList
End Sub ' эта часть убирает пустые значения из комбобоксов

Private Sub UserForm_Activate()
MakeList Sheets("data").Range("j2:j20"), ComboBox1 ' диапазон столбца записывается в комбобок, так же комбобокс ищет по первым буквам.
End Sub
[/vba]
этот код я подвязывал под свою форму, проходит инициализация данных при запуске формы, и они записываются в перечисленные комбобоксы.
Посмотрел код вашей формы. У вас там все расписано, и поски изаписи в комбобоксы. Сделайте по аналогии для необходимых текст боксов, заменив их комбами.

Автор - Santtic
Дата добавления - 04.10.2021 в 16:39
RomanCompass Дата: Понедельник, 04.10.2021, 17:09 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 32
Репутация: 10 ±
Замечаний: 0% ±

Excel 2016
Santtic, Я правильно понял данный код будет находить совпадение в таблице по Ф.И. или НОМЕРА ТЕЛЕФОНА или НОМЕР ПАСПОРТА или НОМЕР ВОДИТЕЛЬСКОГО УДОСТОВЕРЕНИЯ .
Суть в том что если данные клиента уже есть в таблице (то есть он пользовался нашими услугами ) чтобы при заполнение TEXTBOX-ос , система оповещала каким то образом MSGBOX выводила данные строки или к примеру показывала строку в таблице .
 
Ответить
СообщениеSanttic, Я правильно понял данный код будет находить совпадение в таблице по Ф.И. или НОМЕРА ТЕЛЕФОНА или НОМЕР ПАСПОРТА или НОМЕР ВОДИТЕЛЬСКОГО УДОСТОВЕРЕНИЯ .
Суть в том что если данные клиента уже есть в таблице (то есть он пользовался нашими услугами ) чтобы при заполнение TEXTBOX-ос , система оповещала каким то образом MSGBOX выводила данные строки или к примеру показывала строку в таблице .

Автор - RomanCompass
Дата добавления - 04.10.2021 в 17:09
Santtic Дата: Вторник, 05.10.2021, 08:07 | Сообщение № 4
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 181
Репутация: 1 ±
Замечаний: 0% ±

Excel 2016
или к примеру показывала строку в таблице .

Вы изначально не точно описали задание.
Я не спец в макросах, если совпадает с моими решениями что я делал, то подсказываю.
 
Ответить
Сообщение
или к примеру показывала строку в таблице .

Вы изначально не точно описали задание.
Я не спец в макросах, если совпадает с моими решениями что я делал, то подсказываю.

Автор - Santtic
Дата добавления - 05.10.2021 в 08:07
Erjoma1981 Дата: Вторник, 05.10.2021, 13:15 | Сообщение № 5
Группа: Проверенные
Ранг: Участник
Сообщений: 66
Репутация: 23 ±
Замечаний: 0% ±

Excel 2010, 2019
Для паспорта
[vba]
Код

Private Sub TextBox_passport_Change()
    Dim НайденноеЗначение As Range
    If Len(TextBox_passport.Value) Then
        Set НайденноеЗначение = Sheets("2021").ListObjects("OrderList").DataBodyRange.Columns(13).Find(TextBox_passport.Value, LookIn:=xlValues, LookAt:=xlWhole)
        If Not НайденноеЗначение Is Nothing Then
            MsgBox TextBox_passport.Value & " есть в строке " & НайденноеЗначение.Row
        End If
    End If
End Sub
[/vba]
К сообщению приложен файл: NEW_PUBLIC_4.xlsm(133.4 Kb)
 
Ответить
СообщениеДля паспорта
[vba]
Код

Private Sub TextBox_passport_Change()
    Dim НайденноеЗначение As Range
    If Len(TextBox_passport.Value) Then
        Set НайденноеЗначение = Sheets("2021").ListObjects("OrderList").DataBodyRange.Columns(13).Find(TextBox_passport.Value, LookIn:=xlValues, LookAt:=xlWhole)
        If Not НайденноеЗначение Is Nothing Then
            MsgBox TextBox_passport.Value & " есть в строке " & НайденноеЗначение.Row
        End If
    End If
End Sub
[/vba]

Автор - Erjoma1981
Дата добавления - 05.10.2021 в 13:15
MikeVol Дата: Вторник, 05.10.2021, 16:06 | Сообщение № 6
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 126
Репутация: 14 ±
Замечаний: 0% ±

Excel 2019
RomanCompass, Ещё как вариант для Имени в Базе.

[vba]
Код


Private Sub TextBox_name_Change()
Dim ws1 As Worksheet, tbl1 As ListObject, LookupValue As String, FoundCell As Range, answer

    If Trim(Me.TextBox_name.Value) = "" Then
        MsgBox "Пожалуйста, Введите Имя которого нет в Базе"
        Me.TextBox_name.SetFocus
        Exit Sub
    End If

    Set ws1 = Sheets("2021")
    Set tbl1 = ws1.ListObjects("OrderList")
    LookupValue = Me.TextBox_name.Value
    On Error Resume Next
    Set FoundCell = tbl1.DataBodyRange.Columns(2).Find(LookupValue, LookIn:=xlValues, LookAt:=xlWhole)
    On Error GoTo 0

    If Not FoundCell Is Nothing Then
        answer = MsgBox("Это Имя уже существует в данной Базе. " & " в СТРОКЕ НОМЕР " & FoundCell.Row & vbCrLf & "Вы Хотите Повторить данное Имя", vbQuestion + vbYesNo + vbDefaultButton2, " Дублировать ? ")
        Me.ComboBox_cartype.SetFocus

        If answer = vbNo Then
            '            ClearForm
            Me.TextBox_name.Value = ""
            Me.TextBox_name.SetFocus
            Exit Sub
        End If

    End If

End Sub

[/vba]


Ученик - Наблюдатель. Учиться Никогда не поздно.
 
Ответить
СообщениеRomanCompass, Ещё как вариант для Имени в Базе.

[vba]
Код


Private Sub TextBox_name_Change()
Dim ws1 As Worksheet, tbl1 As ListObject, LookupValue As String, FoundCell As Range, answer

    If Trim(Me.TextBox_name.Value) = "" Then
        MsgBox "Пожалуйста, Введите Имя которого нет в Базе"
        Me.TextBox_name.SetFocus
        Exit Sub
    End If

    Set ws1 = Sheets("2021")
    Set tbl1 = ws1.ListObjects("OrderList")
    LookupValue = Me.TextBox_name.Value
    On Error Resume Next
    Set FoundCell = tbl1.DataBodyRange.Columns(2).Find(LookupValue, LookIn:=xlValues, LookAt:=xlWhole)
    On Error GoTo 0

    If Not FoundCell Is Nothing Then
        answer = MsgBox("Это Имя уже существует в данной Базе. " & " в СТРОКЕ НОМЕР " & FoundCell.Row & vbCrLf & "Вы Хотите Повторить данное Имя", vbQuestion + vbYesNo + vbDefaultButton2, " Дублировать ? ")
        Me.ComboBox_cartype.SetFocus

        If answer = vbNo Then
            '            ClearForm
            Me.TextBox_name.Value = ""
            Me.TextBox_name.SetFocus
            Exit Sub
        End If

    End If

End Sub

[/vba]

Автор - MikeVol
Дата добавления - 05.10.2021 в 16:06
RomanCompass Дата: Пятница, 08.10.2021, 17:42 | Сообщение № 7
Группа: Пользователи
Ранг: Новичок
Сообщений: 32
Репутация: 10 ±
Замечаний: 0% ±

Excel 2016
Santtic, я понимаю что могу не правильно описать задачу . Я только начинаю вникать в EXCEL .
 
Ответить
СообщениеSanttic, я понимаю что могу не правильно описать задачу . Я только начинаю вникать в EXCEL .

Автор - RomanCompass
Дата добавления - 08.10.2021 в 17:42
RomanCompass Дата: Суббота, 09.10.2021, 16:42 | Сообщение № 8
Группа: Пользователи
Ранг: Новичок
Сообщений: 32
Репутация: 10 ±
Замечаний: 0% ±

Excel 2016
RomanCompass, спасибо MikeVol ,Erjoma1981 за помощь! Оба варианта работают .
Единственное в варианте от MikeVol убрал МsgBox "Пожалуйста, Введите Имя которого нет в Базе"
Какой лучше выбрать ?
В том плане чтобы прога работала легче и стабильно .
Не знаю может я сейчас ерунду несу поправьте если кто разбирается .
 
Ответить
СообщениеRomanCompass, спасибо MikeVol ,Erjoma1981 за помощь! Оба варианта работают .
Единственное в варианте от MikeVol убрал МsgBox "Пожалуйста, Введите Имя которого нет в Базе"
Какой лучше выбрать ?
В том плане чтобы прога работала легче и стабильно .
Не знаю может я сейчас ерунду несу поправьте если кто разбирается .

Автор - RomanCompass
Дата добавления - 09.10.2021 в 16:42
RomanCompass Дата: Суббота, 09.10.2021, 16:50 | Сообщение № 9
Группа: Пользователи
Ранг: Новичок
Сообщений: 32
Репутация: 10 ±
Замечаний: 0% ±

Excel 2016
Сново поправляюсь %)
Не подумал об этом изначально .Нужен поиск этих данных по всех книге .
Можно сделать чтобы показывало строку в таблице с данными ? (а не просто выводило сообщение с номером строки )
Дело в том что таблица будет большая и не совсем удобно будет искать строку .

К сообщению приложен файл: 8931570.png(139.1 Kb)
 
Ответить
СообщениеСново поправляюсь %)
Не подумал об этом изначально .Нужен поиск этих данных по всех книге .
Можно сделать чтобы показывало строку в таблице с данными ? (а не просто выводило сообщение с номером строки )
Дело в том что таблица будет большая и не совсем удобно будет искать строку .


Автор - RomanCompass
Дата добавления - 09.10.2021 в 16:50
Erjoma1981 Дата: Воскресенье, 10.10.2021, 06:59 | Сообщение № 10
Группа: Проверенные
Ранг: Участник
Сообщений: 66
Репутация: 23 ±
Замечаний: 0% ±

Excel 2010, 2019
[vba]
Код
Private Sub TextBox_passport_Change()
Dim НайденноеЗначение As Range
If Len(TextBox_passport.Value) Then
Set НайденноеЗначение = Sheets("2021").ListObjects("OrderList").DataBodyRange.Columns(13).Find(TextBox_passport.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not НайденноеЗначение Is Nothing Then
'MsgBox TextBox_passport.Value & " есть в строке " & НайденноеЗначение.Row
Sheets("2021").Rows(НайденноеЗначение.Row).Select
End If
End If
End Sub
[/vba]


Сообщение отредактировал Erjoma1981 - Воскресенье, 10.10.2021, 07:00
 
Ответить
Сообщение[vba]
Код
Private Sub TextBox_passport_Change()
Dim НайденноеЗначение As Range
If Len(TextBox_passport.Value) Then
Set НайденноеЗначение = Sheets("2021").ListObjects("OrderList").DataBodyRange.Columns(13).Find(TextBox_passport.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not НайденноеЗначение Is Nothing Then
'MsgBox TextBox_passport.Value & " есть в строке " & НайденноеЗначение.Row
Sheets("2021").Rows(НайденноеЗначение.Row).Select
End If
End If
End Sub
[/vba]

Автор - Erjoma1981
Дата добавления - 10.10.2021 в 06:59
MikeVol Дата: Воскресенье, 10.10.2021, 23:14 | Сообщение № 11
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 126
Репутация: 14 ±
Замечаний: 0% ±

Excel 2019
RomanCompass, Доброго времени суток. Упрощённый вариант вам до кучи с выделением строки с уже имеющим именем в базе.
[vba]
Код

Private Sub TextBox_name_Change()
    Dim ws1 As Worksheet, tbl1 As ListObject, FoundCell As Range, answer As VbMsgBoxResult

    Set ws1 = Sheets("2021")
    Set tbl1 = ws1.ListObjects("OrderList")
    On Error Resume Next
    Set FoundCell = tbl1.DataBodyRange.Columns(2).Find(Me.TextBox_name.Value, LookIn:=xlValues, LookAt:=xlWhole)
    On Error GoTo 0

    If Not FoundCell Is Nothing Then
        Rows(FoundCell.Row).Select
    End If

End Sub
[/vba]


Ученик - Наблюдатель. Учиться Никогда не поздно.

Сообщение отредактировал MikeVol - Понедельник, 11.10.2021, 09:31
 
Ответить
СообщениеRomanCompass, Доброго времени суток. Упрощённый вариант вам до кучи с выделением строки с уже имеющим именем в базе.
[vba]
Код

Private Sub TextBox_name_Change()
    Dim ws1 As Worksheet, tbl1 As ListObject, FoundCell As Range, answer As VbMsgBoxResult

    Set ws1 = Sheets("2021")
    Set tbl1 = ws1.ListObjects("OrderList")
    On Error Resume Next
    Set FoundCell = tbl1.DataBodyRange.Columns(2).Find(Me.TextBox_name.Value, LookIn:=xlValues, LookAt:=xlWhole)
    On Error GoTo 0

    If Not FoundCell Is Nothing Then
        Rows(FoundCell.Row).Select
    End If

End Sub
[/vba]

Автор - MikeVol
Дата добавления - 10.10.2021 в 23:14
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Поиск в Умной Талице через Юсэр Форм (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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