窗体上的模糊查询问题，请高手指点！！！

store88168

请看附件中Sheet1中,黄色区域双击后UserForm1窗体，出现四个空白的Textbox．我现在的查询就是按照输入第一个后，再输入第二个．第三个，第四个，这么样的一个顺序查询，但是我不想这样查询，我有可能输入第二，再输入第一个，再输入第三个，等等，这样查询就方便很好，请高手指点一下吧，很是烦恼，在线等待您的回复！！！！

store88168

有高手明白我的意思吗，在线等待你的回复呀

store88168

等了好久继续等待你的回复！！！！！！！！！！！

zhaogang1960

楼主是否要求不按照顺序，只要文本框有值就是and的关系？使用数组+字典难度有点大，ADO很容易做到

zhaogang1960

Option Compare Text
'引用Microsoft ActiveX Data Objects 2.x Library
Dim cnn As New ADODB.Connection
Dim rs As ADODB.Recordset
Private Sub ListView1_DblClick()
   'On Error Resume Next
    ActiveCell.Value = ListView1.SelectedItem
    ActiveCell.Offset(0, 1).Value = ListView1.SelectedItem.SubItems(1)
    ActiveCell.Offset(0, 2).Value = ListView1.SelectedItem.SubItems(2)
    ActiveCell.Offset(0, 3).Value = ListView1.SelectedItem.SubItems(3)
    UserForm1.Hide
    Me.TextBox1.Value = ""
End Sub

Private Sub TextBox1_Change()
    Call Comm
End Sub

Private Sub TextBox2_AfterUpdate()
    Call Comm
End Sub

Private Sub TextBox3_AfterUpdate()
    Call Comm
End Sub
Private Sub TextBox4_AfterUpdate()
    Call Comm
End Sub

Private Sub UserForm_Initialize()
  Me.TextBox1.SetFocus
  Me.TextBox1.Value = ""
  ListView1.ColumnHeaders.Clear
  ListView1.ListItems.Clear
  ListView1.FullRowSelect = True
  ListView1.Gridlines = True
  With ListView1
    .ColumnHeaders.Add , , Sheet1.Cells(1, 7), .Width / 4
    .ColumnHeaders.Add , , Sheet1.Cells(1, 8), .Width / 4
    .ColumnHeaders.Add , , Sheet1.Cells(1, 9), .Width / 5
    .ColumnHeaders.Add , , Sheet1.Cells(1, 10), .Width / 5
    .View = lvwReport
  End With
  cnn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName
  Call Comm
  TextBox1.SetFocus
  Me.TextBox1.Value = ""
End Sub

Public Sub Comm()
   Dim i&, j&, arr, s$, t$, SQL$
   arr = [g1:j1&""]
   For i = 1 To 4
        t = Me.Controls("TextBox" & i).Text
        If Len(t) Then s = s & " and " & arr(i) & " like '%" & t & "%'"
   Next
   SQL = "select * from [Sheet1$" & [g1].CurrentRegion.Address(0, 0) & "]"
    If Len(s) Then SQL = SQL & " where " & Mid(s, 6)
    On Error Resume Next
    Set rs = New ADODB.Recordset
    rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
    With ListView1
        .ListItems.Clear
        For i = 1 To rs.RecordCount
            .ListItems.Add , , rs.Fields(0).Value
            For j = 1 To rs.Fields.Count - 1
                .ListItems(i).SubItems(j) = rs.Fields(j).Value
            Next
            rs.MoveNext
        Next
    End With
    rs.MoveFirst
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    On Error Resume Next
    rs.Close
    cnn.Close
    Set rs = Nothing
    Set cnn = Nothing
End Sub

zhaogang1960

窗模体糊查询SS.rar (23.75 KB, 下载次数: 372)

2011-3-19 19:29 上传

点击文件名下载附件

store88168

楼上的朋友，很谢谢你的回复，问题解决了，但是又有一个问题了，查找有这个Option Compare Text　应该不区分大小写的中吧，但是现在您给我的表中要区分大小写呢？

store88168

zhaogang：
　　您好，Textbox1,Textbox2,Textbox3,Textbox4可不可以不用鼠标来移位,好像移到Textbox2后,就只能用鼠标点到Textbox1了,能不能用键盘的移动键来移动呢,再请您的回复

zhaogang1960

Option Compare Text　对ADO好像没有用，用UCase都转为大写就可以了
Public Sub Comm()
   Dim i&, j&, arr, s$, t$, SQL$
   arr = [g1:j1&""]
   For i = 1 To 4
        t = Me.Controls("TextBox" & i).Text
        If Len(t) Then s = s & " and UCase(" & arr(i) & ") like '%" & UCase(t) & "%'"
   Next
   SQL = "select * from [Sheet1$" & [g1].CurrentRegion.Address(0, 0) & "]"
    If Len(s) Then SQL = SQL & " where " & Mid(s, 6)
    On Error Resume Next
    Set rs = New ADODB.Recordset
    rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
    With ListView1
        .ListItems.Clear
        For i = 1 To rs.RecordCount
            .ListItems.Add , , rs.Fields(0).Value
            For j = 1 To rs.Fields.Count - 1
                .ListItems(i).SubItems(j) = rs.Fields(j).Value
            Next
            rs.MoveNext
        Next
    End With
    rs.MoveFirst
End Sub

zhaogang1960

窗模体糊查询SS.rar (22.76 KB, 下载次数: 283)

2011-3-21 10:36 上传

点击文件名下载附件