从输入到 Excel VBA 中的 TextBox 中的搜索条件填充 ListBox

Question

这个问题我以前也发过，但是觉得太复杂了，解释的不是很好。这次我只是以一个简单的 UserForm 为例。

我想通过在文本框中输入搜索条件来填充列表框。

我有三列：

A 栏 = 图书馆卡号

B 列 = 学生姓名

C 列 = 书籍参考

我有一个用户表单：

TextBox = txtlcn（借书证号）

TextBox = txtpn（学生姓名）

TextBox = txtbr（供书籍参考）

命令按钮 = cmdfinddetails（查找详细信息）

我想要做的是将 TextBox 'txtbr' 更改为 ListBox，这样我就可以查看学生是否有不止一本书借给他们。该过程将是：

1. 一名学生在文本框‘txtlcn’中输入他们的借书证号码，然后 点击命令按钮‘cmdfinddetails’
2. 代码将搜索该学生的姓名和所有书籍 向他们预订的参考资料。
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 更改为列表框，我能够通过以下添加使您的代码正常工作（查找学生姓名并添加引用到 txtbr 列表框的所有书籍）：

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

我制作了一个测试用户表单和一些模拟数据，这对我有用。希望您发现它也适合您。