vigl, Еще добавлю, Вы помните как Дядя Федор , Шарик и Матроскин письмо писали? Вот так и с программированием, надерганные рабочие куски соединенные не всегда дают рабочий вариант. Короче, дебагер вам в руки.
vigl, Еще добавлю, Вы помните как Дядя Федор , Шарик и Матроскин письмо писали? Вот так и с программированием, надерганные рабочие куски соединенные не всегда дают рабочий вариант. Короче, дебагер вам в руки.bmv98rus
Замечательный Временно просто медведь , процентов на 20.
Еще добавлю, Вы помните как Дядя Федор , Шарик и Матроскин письмо писали? Вот так и с программированием, надерганные рабочие куски соединенные не всегда дают рабочий вариант. Короче, дебагер вам в руки.
оставил только столбец, откуда заполняется ListBox. этого должно хватить.
Еще добавлю, Вы помните как Дядя Федор , Шарик и Матроскин письмо писали? Вот так и с программированием, надерганные рабочие куски соединенные не всегда дают рабочий вариант. Короче, дебагер вам в руки.
оставил только столбец, откуда заполняется ListBox. этого должно хватить.vigl
Private Sub txtKod_Change() FillList txtKod.Text End Sub
Private Sub UserForm_Activate() Call FillList End Sub
Private Sub FillList(Optional txtfltr As String) dim lt As Integer lt = Len(txtfltr) lstKod.Clear '***выбор листа***************************************************************** Sheets("База").Select Dim myRange As Range, myCell As Range, myCollection As New Collection, _ myElement As Variant, i As Long
'присваиваем переменной myRange диапазон ячеек с исходным списком элементов Set myRange = Range("A2:A5010")
'***заполняем ListBox уникальными элементами*********************************** On Error Resume Next For Each myCell In myRange If Left(myCell, lt) = txtfltr Then myCollection.Add CStr(myCell.Value), CStr(myCell.Value) Next myCell On Error GoTo 0
For Each myElement In myCollection frmFind.lstKod.AddItem myElement Next myElement
'***сортировка ListBox********************************************************** With lstKod: iCountList = .ListCount - 1
For iCount = iCountList To 1 Step -1 For iCountTemp = iCountList To 1 Step -1 If StrComp(.List(iCountTemp), .List(iCountTemp - 1), vbTextCompare) = -1 Then .AddItem .List(iCountTemp), iCountTemp - 1 .RemoveItem iCountTemp + 1 End If Next Next End With '********************************************************************************** End Sub
[/vba]
странно, но в целом все еще проще
[vba]
Код
Private Sub txtKod_Change() FillList txtKod.Text End Sub
Private Sub UserForm_Activate() Call FillList End Sub
Private Sub FillList(Optional txtfltr As String) dim lt As Integer lt = Len(txtfltr) lstKod.Clear '***выбор листа***************************************************************** Sheets("База").Select Dim myRange As Range, myCell As Range, myCollection As New Collection, _ myElement As Variant, i As Long
'присваиваем переменной myRange диапазон ячеек с исходным списком элементов Set myRange = Range("A2:A5010")
'***заполняем ListBox уникальными элементами*********************************** On Error Resume Next For Each myCell In myRange If Left(myCell, lt) = txtfltr Then myCollection.Add CStr(myCell.Value), CStr(myCell.Value) Next myCell On Error GoTo 0
For Each myElement In myCollection frmFind.lstKod.AddItem myElement Next myElement
'***сортировка ListBox********************************************************** With lstKod: iCountList = .ListCount - 1
For iCount = iCountList To 1 Step -1 For iCountTemp = iCountList To 1 Step -1 If StrComp(.List(iCountTemp), .List(iCountTemp - 1), vbTextCompare) = -1 Then .AddItem .List(iCountTemp), iCountTemp - 1 .RemoveItem iCountTemp + 1 End If Next Next End With '********************************************************************************** End Sub
Private Sub txtKod_Change() FillList txtKod.Text End Sub
Private Sub UserForm_Activate() Call FillList End Sub
Private Sub FillList(Optional txtfltr As String) Dim lt As Integer, Arr lt = Len(txtfltr) lstKod.Clear '***выбор листа***************************************************************** Sheets("База").Select Dim myRange As Range, myCell As Range, myCollection As New Collection, _ myElement As Variant, i As Long
'присваиваем массиву диапазон ячеек с исходным списком элементов Arr = Range("A2:A5010")
'***заполняем ListBox уникальными элементами*********************************** On Error Resume Next For i = 1 To UBound(Arr, 1) If Left(Arr(i, 1), lt) = txtfltr Then myCollection.Add CStr(Arr(i, 1)), CStr(Arr(i, 1)) Next On Error GoTo 0
For Each myElement In myCollection frmFind.lstKod.AddItem myElement Next myElement
'***сортировка ListBox********************************************************** With lstKod: iCountList = .ListCount - 1 For iCount = iCountList To 1 Step -1 For iCountTemp = iCountList To 1 Step -1 If StrComp(.List(iCountTemp), .List(iCountTemp - 1), vbTextCompare) = -1 Then .AddItem .List(iCountTemp), iCountTemp - 1 .RemoveItem iCountTemp + 1 End If Next Next End With '********************************************************************************** End Sub
[/vba]
заполнять через массив. ну и конечно исходные данные тут берутся жесткой областью, что тоже не правильно , но это сами уже.
И самое главное, в сравнении с котом в шапке, я котенок, и если б дали пример сразу еже на первом листе темы получили б результат и более качественный чем этот. Я не макрушник.
еще правильнее так
[vba]
Код
Private Sub txtKod_Change() FillList txtKod.Text End Sub
Private Sub UserForm_Activate() Call FillList End Sub
Private Sub FillList(Optional txtfltr As String) Dim lt As Integer, Arr lt = Len(txtfltr) lstKod.Clear '***выбор листа***************************************************************** Sheets("База").Select Dim myRange As Range, myCell As Range, myCollection As New Collection, _ myElement As Variant, i As Long
'присваиваем массиву диапазон ячеек с исходным списком элементов Arr = Range("A2:A5010")
'***заполняем ListBox уникальными элементами*********************************** On Error Resume Next For i = 1 To UBound(Arr, 1) If Left(Arr(i, 1), lt) = txtfltr Then myCollection.Add CStr(Arr(i, 1)), CStr(Arr(i, 1)) Next On Error GoTo 0
For Each myElement In myCollection frmFind.lstKod.AddItem myElement Next myElement
'***сортировка ListBox********************************************************** With lstKod: iCountList = .ListCount - 1 For iCount = iCountList To 1 Step -1 For iCountTemp = iCountList To 1 Step -1 If StrComp(.List(iCountTemp), .List(iCountTemp - 1), vbTextCompare) = -1 Then .AddItem .List(iCountTemp), iCountTemp - 1 .RemoveItem iCountTemp + 1 End If Next Next End With '********************************************************************************** End Sub
[/vba]
заполнять через массив. ну и конечно исходные данные тут берутся жесткой областью, что тоже не правильно , но это сами уже.
И самое главное, в сравнении с котом в шапке, я котенок, и если б дали пример сразу еже на первом листе темы получили б результат и более качественный чем этот. Я не макрушник.bmv98rus
Замечательный Временно просто медведь , процентов на 20.
Сообщение отредактировал bmv98rus - Суббота, 10.02.2018, 23:16
bmv98rus, в очередной раз благодарю Вас за помощь!
в самом начале я не выложил файл т.к. не хотел отвлекать знающих людей своими проблемами в надежде на то, что кто-то подскажет готовое типовое решение т.к. такая организация системы поиска имеется во многих программных продуктах. что касается общения с котом в шапке, т.е. с RAN - видит Бог, я обидеть его не хотел, просто на других ресурсах связанные с программированием, есть такая категория участников, которые если даже знают решение, то пока не нахомят, ни за что не помогут. я думал, что он из таких. ну, раз незаслуженно обидел человека, готов извинится.
bmv98rus, в очередной раз благодарю Вас за помощь!
в самом начале я не выложил файл т.к. не хотел отвлекать знающих людей своими проблемами в надежде на то, что кто-то подскажет готовое типовое решение т.к. такая организация системы поиска имеется во многих программных продуктах. что касается общения с котом в шапке, т.е. с RAN - видит Бог, я обидеть его не хотел, просто на других ресурсах связанные с программированием, есть такая категория участников, которые если даже знают решение, то пока не нахомят, ни за что не помогут. я думал, что он из таких. ну, раз незаслуженно обидел человека, готов извинится.vigl
Сообщение отредактировал vigl - Суббота, 10.02.2018, 23:59
которые если даже знают решение, то пока не нахомят, ни за что не помогут
Неее, этот не из таких, да и не думаю что вы его обидели, скорее сами себя могли наказать долгим отсутсвием ответа. А пример даже согласно правилам обязателен, ведь часто даже универсальное решение требует адаптации под конкретный материал, много я поменял в том что у вас было? - нет. [/offtop]
которые если даже знают решение, то пока не нахомят, ни за что не помогут
Неее, этот не из таких, да и не думаю что вы его обидели, скорее сами себя могли наказать долгим отсутсвием ответа. А пример даже согласно правилам обязателен, ведь часто даже универсальное решение требует адаптации под конкретный материал, много я поменял в том что у вас было? - нет. [/offtop]bmv98rus
Замечательный Временно просто медведь , процентов на 20.
bmv98rus, тот факт, что участники данного ресурса не такие как те, о которых я написал в своем предыдущем комментарии - уже радует. надеюсь на дальнейшее сотрудничество с участниками форума и взаимопомощь, хотя от меня помощи практически никакой. я скорее всего из тех, кто эту помощь просит.
bmv98rus, тот факт, что участники данного ресурса не такие как те, о которых я написал в своем предыдущем комментарии - уже радует. надеюсь на дальнейшее сотрудничество с участниками форума и взаимопомощь, хотя от меня помощи практически никакой. я скорее всего из тех, кто эту помощь просит.vigl