Заполнение ListBox из критериев поиска, введенных в TextBox в Excel VBA

Question

Я поставил эту проблему раньше, однако, я думаю, что это было слишком сложно, и я не очень хорошо ее объяснил. На этот раз я просто использую простой UserForm в качестве примера.

Я хочу заполнить ListBox, введя критерии поиска в текстовое поле.

У меня есть три колонки:

Колонка A = Номер Библиотечная карточка

Колонка B = зрачка Имя

Колонка C = Book Reference

У меня есть UserForm:

TextBox = txtlcn (для библиотеки Номер карты)

TextBox = txtpn (для зрачка Имя)

TextBox = txtbr (для справочника)

Command Кнопка = cmdfinddetails (Найти детали)

Что я хочу сделать, это изменить TextBox 'txtbr' в ListBox, так что я вижу, есть ли у ученика более одной книги, предоставленной им. Процесс будет:

1. ученик входит в их библиотеке номер карты в TextBox «txtlcn» и щелчков по командной кнопке
2. код будет искать имя этого ученика и все книги «cmdfinddetails» ссылки забронированы для них.
3. Ссылка на книги будет отображаться в ListBox.

Я пробовал много вещей, связанных с RowSource, но всегда перечисляет ссылки каждого ученика на книгу. Ниже приведен пример кода.

Private Sub cmdfinddetails_Click() 
Set xSht = Sheets("Library") 
     Lastrow = xSht.Range("A" & Rows.Count).End(xlUp).Row 
     strSearch = txtlcn.Text 
        Set aCell = xSht.Range("A1:A" & Lastrow).Find 

(What:=strSearch, LookIn:=xlFormulas, _ 
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
    MatchCase:=False, SearchFormat:=False) 

     If Not aCell Is Nothing And txtpn.Value = "" Then 
     GoTo libcardrefvalid  
    Else 
MsgBox "Oops! That Library Card does not exist. Please try again.", Title:="We LOVE Reading ;-)" 
txtlcn.Value = "" 
     End If 
    Exit Sub 
libcardrefvalid: 

row_number = 0 
Do 
DoEvents 
row_number = row_number + 1 
item_in_review = Sheets("Library").Range("A" & row_number) 
If item_in_review = txtlcn.Text Then 
txtpn.Text = Sheets("Library").Range("B" & row_number) 
txtbr.Text = Sheets("Library").Range("C" & row_number) 
End If 
Loop Until item_in_review = "" 

End Sub 

Любая помощь была бы принята с благодарностью.

спасибо.

Answer 1

Предполагая, что вы уже изменили txtbr в ListBox, я был в состоянии получить код работает (отрываясь имя ученика и добавляя все книги, на которые ссылается к txtbr ListBox) со следующими дополнениями:

Private Sub CommandButton1_Click() 
'clears the pupil name (caused an error if not done) 
txtpn.Text = "" 
Set xSht = Sheets("Library") 
     Lastrow = xSht.Range("A" & Rows.Count).End(xlUp).Row 
     strSearch = txtlcn.Text 
        Set aCell = xSht.Range("A1:A" & Lastrow).Find(What:=strSearch, LookIn:=xlFormulas, _ 
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
    MatchCase:=False, SearchFormat:=False) 

     If Not aCell Is Nothing And txtpn.Value = "" Then 
     GoTo libcardrefvalid 
    Else 
MsgBox "Oops! That Library Card does not exist. Please try again.", Title:="We LOVE Reading ;-)" 
txtlcn.Value = "" 
     End If 
    Exit Sub 
libcardrefvalid: 

row_number = 0 
'clears the listbox so that you have dont have a continuously growing list 
txtbr.Clear 
Do 
DoEvents 
row_number = row_number + 1 
item_in_review = Sheets("Library").Range("A" & row_number) 
If item_in_review = txtlcn.Text Then 
txtpn.Text = Sheets("Library").Range("B" & row_number) 
'Adds the book reference number to the list box 
txtbr.AddItem Sheets("Library").Range("C" & row_number) 
End If 
Loop Until item_in_review = "" 
End Sub 

Я сделал тестовую пользовательскую форму и некоторые макеты данных, и это сработало для меня. Надеюсь, вы обнаружите, что это так и для вас.