查询窗体这个怎么弄

xinqingox

查询窗体，可以输入日期查询，输入日期后，列表自动显示输入日期的项目，单据编号和客户名称同样也是这样的，单独输入任何一个都可以查询，还有就是，出库日期、单据编号、客户名称支持联动，可以实现精准查找（日期、编号、名称支持关键字输入），请老师帮帮，谢谢！

zpy2

wps内置的筛选不行吗？

zpy2

类似wps内置的筛选吗？

xinqingox

zpy2 发表于 2023-3-15 13:36
类似wps内置的筛选吗？

不想用筛选，用筛选的话还要到汇总表里去查找

3190496160

Private Sub ComboBox1_Change()
Dim ar As Variant
Dim br()
With Sheets("汇总")
     r = .Cells(Rows.Count, 1).End(xlUp).Row
     ar = .Range("a2:r" & r)
End With
ReDim br(1 To UBound(ar), 1 To UBound(ar, 2))
lh = 2
zd = ComboBox1.Text
For i = 2 To UBound(ar)
    If Trim(ar(i, lh)) <> "" Then
        If Trim(ar(i, lh)) = zd Then
            n = n + 1
            For j = 1 To UBound(ar, 2)
                br(n, j) = ar(i, j)
            Next j
        End If
    End If
Next i
If n = "" Then MsgBox "没有所选条件的数据": Exit Sub
With Me.ListBox1
    .Clear
    .List = br
End With
End Sub

Private Sub ComboBox2_Change()
Dim ar As Variant
Dim br()
With Sheets("汇总")
     r = .Cells(Rows.Count, 1).End(xlUp).Row
     ar = .Range("a2:r" & r)
End With
ReDim br(1 To UBound(ar), 1 To UBound(ar, 2))
lh = 3
zd = ComboBox2.Text
For i = 2 To UBound(ar)
    If Trim(ar(i, lh)) <> "" Then
        If Trim(ar(i, lh)) = zd Then
            n = n + 1
            For j = 1 To UBound(ar, 2)
                br(n, j) = ar(i, j)
            Next j
        End If
    End If
Next i
If n = "" Then MsgBox "没有所选条件的数据": Exit Sub
With Me.ListBox1
    .Clear
    .List = br
End With

End Sub

Private Sub ComboBox3_Change()
Dim ar As Variant
Dim br()
With Sheets("汇总")
     r = .Cells(Rows.Count, 1).End(xlUp).Row
     ar = .Range("a2:r" & r)
End With
ReDim br(1 To UBound(ar), 1 To UBound(ar, 2))
lh = 6
zd = ComboBox3.Text
For i = 2 To UBound(ar)
    If Trim(ar(i, lh)) <> "" Then
        If Trim(ar(i, lh)) = zd Then
            n = n + 1
            For j = 1 To UBound(ar, 2)
                br(n, j) = ar(i, j)
            Next j
        End If
    End If
Next i
If n = "" Then MsgBox "没有所选条件的数据": Exit Sub
With Me.ListBox1
    .Clear
    .List = br
End With

End Sub

Private Sub CommandButton1_Click()
Worksheets("汇总").Select
With Sheets("汇总")
     r = .Cells(Rows.Count, 1).End(xlUp).Row
     ar = .Range("a2:r" & r)
End With
ListBox1.List = ar
End Sub
Private Sub CommandButton2_Click()
Unload Me
End Sub
Private Sub UserForm_Initialize()
    Dim nRow%, Arr()
    Dim ds As Object
    Set ds = CreateObject("Scripting.Dictionary")
    Set d = CreateObject("Scripting.Dictionary")
    Set dc = CreateObject("Scripting.Dictionary")
    With Worksheets("汇总")
        nRow = .Range("a1048576").End(xlUp).Row
        Arr = .Range("a1:f" & nRow).Value
    End With
    For i = 3 To nRow
        If Trim(Arr(i, 2)) <> "" Then
            ds(Arr(i, 2)) = ""
        End If
        If Trim(Arr(i, 3)) <> "" Then
            d(Arr(i, 3)) = ""
        End If
        If Trim(Arr(i, 6)) <> "" Then
            dc(Arr(i, 6)) = ""
        End If
    Next
    Me.ComboBox1.List = ds.keys
    Me.ComboBox2.List = d.keys
    Me.ComboBox3.List = dc.keys
    ListBox1.ColumnCount = 18
    Call CommandButton1_Click
End Sub

3190496160

查询窗体.rar (31.15 KB, 下载次数: 34)

2023-3-15 16:27 上传

点击文件名下载附件

xinqingox

3190496160 发表于 2023-3-15 16:27

谢谢了老师，再次得到您的帮助，辛苦辛苦！

太极拍天雄

自己做个练习同时留个Mark，下回可以参考大神的实例。