求助，窗体列表框关键字模糊搜索，并把选择内容填入指定单元格

1204dz

想要效果：有附件
1、点击“首页”B6单元格会弹出一个窗体
2、窗体内有一个关键字模糊搜索栏和一个列表框
3、列表框数据来源为“标准试验”中B:F列（列表框内容分5列带标题，分别为报告编号、取土场名称、批复日期、最大干密度、最佳含水率）
4、列表框内容可以用鼠标滚轮滚动
5、选择列表框中的某行内容，双击后对应报告编号和对应取土场名称合并填入“首页”中B6单元格内，例如“BG-2022-TGJ-09-001(XXX取土场)”


                        谢谢老师们！！！

1204dz

恳请各位大侠、老师们帮帮忙！

3190496160

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
With ListBox1
    For i = 1 To .ListCount - 1
        If .Selected(i) = True Then
            zf = .List(i, 0) & "(" & .List(i, 1) & ")"
            Exit For
        End If
    Next i
End With
ActiveCell = zf
End Sub

Private Sub TextBox1_Change()
zd = TextBox1.Text
If zd = "" Then Exit Sub
Dim ar As Variant
Dim arr()
With Sheets("标准试验")
    r = .Cells(Rows.Count, 2).End(xlUp).Row
    ar = .Range("b2:f" & r)
End With
ReDim arr(1 To UBound(ar), 1 To UBound(ar, 2))
n = 1
For j = 1 To UBound(ar, 2)
    arr(n, j) = ar(1, j)
Next j
For i = 2 To UBound(ar)
    If InStr(ar(i, 1), zd) > 0 Then
        n = n + 1
        For j = 1 To UBound(ar, 2)
            arr(n, j) = ar(i, j)
        Next j
    End If
Next i
If n = "" Then Exit Sub
With ListBox1
    .Clear
    .List = arr
End With
End Sub
Private Sub UserForm_Initialize()
With Sheets("标准试验")
    r = .Cells(Rows.Count, 2).End(xlUp).Row
    ar = .Range("b2:f" & r)
End With
ListBox1.List = ar
End Sub

3190496160

附件ldz.rar (31.69 KB, 下载次数: 19)

2022-10-22 12:51 上传

点击文件名下载附件

1204dz

3190496160 发表于 2022-10-22 12:51

老师，您好，非常感谢您，能不能麻烦帮忙再修改一下，具体内容见”附件ldz111“

1204dz

求助大侠、老师们，窗体列表框区域内容怎么能通过鼠标滚轮上下滚动，见附件