[已解决]两个条件改为单个的查询

zzk386

还没见到高手的回复呀,想必是有一定难度......[em06][em06][em06]

amulee

没啥特别难度。你保留以下调用到的过程，其余的可以删了。

Private Sub CommandButton2_Click() '主查询按钮
    On Error Resume Next
    Sheets("结果显示").Visible = 2 '隐藏“结果显示”工作表
    Sheets("结果显示").Rows("2:65536") = "" '清空
    CommandButton4.Caption = "显示查询结果"
    '建立ADO查询
    Dim adoCN As Object, i As Integer
    Dim SQL As String, strTJ As String, temp As String
    Dim MySht As Worksheet
    Set adoCN = CreateObject("ADODB.Connection")
    '设定SQL
    If CheckBox1.Value = True Then
        For Each MySht In Worksheets
            If MySht.Name <> "结果显示" And MySht.Name <> "界面" _
                And MySht.Name <> "帮助" And MySht.Name <> "引用" Then
                
                SQL = SQL & " Union all select " & MySht.Name & ",* from [" & MySht.Name & "$]"
                
            End If
        Next
        SQL = Right(SQL, Len(SQL) - 11)
    Else
        If ComboBox1.Value <> "" Then
            SQL = "select " & ComboBox1.Value & ",* from [" & ComboBox1.Value & "$]"
        Else
            MsgBox "未选择表格"
            Exit Sub
        End If
    End If
    '设定条件
    For i = 3 To 5
        temp = UserForm2.Controls("Combobox" & i).Value
        If Len(temp) > 0 Then
            strTJ = strTJ & " and " & UserForm2.Controls("Label" & i + 2).Caption & "=""" & temp & """"
        End If
    Next i
    '设定物品查询条件。如果没有具体名称则按照大类查找
    If Len(ComboBox3.Text) = 0 And Len(ComboBox2.Text) > 0 Then
        '查找大类
        temp = ComboBox2.Text
        Dim stRow&, edRow&, strList
        stRow = Sheets("引用").Range("A:A").Find(temp, Sheets("引用").Range("A2"), , , , xlNext).Row
        edRow = WorksheetFunction.Max(Sheets("引用").Range("B65536").End(xlUp).Row, _
                Sheets("引用").Range("A:A").Find("*", Sheets("引用").Range("A" & stRow), , , , xlNext).Row - 1)
        strList = Join(Application.Transpose(Sheets("引用").Range("B" & stRow & ":B" & edRow)), """,""")
        strTJ = strTJ & " and 具体名称 in " & "(""" & strList & """)"
    End If
    '设定日期条件
    If CheckBox2.Value = True Then
        '两个日期都要填写
        If Len(TextBox1.Text) * Len(TextBox2.Text) > 0 Then
            strTJ = strTJ & " and 日期>=#" & TextBox1.Text & "# and 日期<=#" & TextBox2.Text & "#"
        Else
            MsgBox "日期没有填写完整"
            TextBox1.SetFocus
            Exit Sub
        End If
    End If
    '若有条件，则添加条件
    If Len(strTJ) > 0 Then
        SQL = "select * from (" & SQL & ") where " & Right(strTJ, Len(strTJ) - 5)
    End If
    '打开连接
    adoCN.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & ThisWorkbook.FullName & _
            ";Extended Properties=Excel 8.0"
    
    Sheets("结果显示").Range("A2").CopyFromRecordset adoCN.Execute(SQL)
    '关闭连接
    adoCN.Close
    '写入listbox1中,及各种显示
    Call 列表框显示
    Call 显示数值
    If Len(ComboBox3.Text) = 0 Then
        Call 各种
    Else
        Call 单位名称
    End If
End Sub

一点不自在

版主真厉害,上面附件中这么多的程序都压缩了成一点了,请求版主在每条后面写上详细注释,让广大菜鸟能根据注释去理解,那样就更美了.[em17][em17][em17]

[此贴子已经被作者于2010-1-25 20:51:24编辑过]

zzk386

测试中发现了一些问题:

YSjMcEnd.rar (55.51 KB, 下载次数: 0)

2010-1-26 10:54 上传

点击文件名下载附件
查询测试碰到了怪问题,请高手解决

amulee

改了一下：

Private Sub CommandButton2_Click() '主查询按钮
    On Error Resume Next
    Sheets("结果显示").Visible = 2 '隐藏“结果显示”工作表
    Sheets("结果显示").Rows("2:65536") = "" '清空
    CommandButton4.Caption = "显示查询结果"
    '建立ADO查询
    Dim adoCN As Object, i As Integer
    Dim SQL As String, strTJ As String, temp As String
    Dim MySht As Worksheet
    Set adoCN = CreateObject("ADODB.Connection")
    '设定SQL
    If CheckBox1.Value = True Then
        For Each MySht In Worksheets
            If MySht.Name <> "结果显示" And MySht.Name <> "界面" _
                And MySht.Name <> "帮助" And MySht.Name <> "引用" Then
                
                SQL = SQL & " Union all select " & MySht.Name & ",* from [" & MySht.Name & "$]"
                
            End If
        Next
        SQL = Right(SQL, Len(SQL) - 11)
    Else
        If ComboBox1.Value <> "" Then
            SQL = "select " & ComboBox1.Value & ",* from [" & ComboBox1.Value & "$]"
        Else
            MsgBox "未选择表格"
            Exit Sub
        End If
    End If
    '设定条件
    For i = 3 To 5
        temp = UserForm2.Controls("Combobox" & i).Value
        If Len(temp) > 0 Then
            strTJ = strTJ & " and " & UserForm2.Controls("Label" & i + 2).Caption & "=""" & temp & """"
        End If
    Next i
    '设定物品查询条件。如果没有具体名称则按照大类查找
    If Len(ComboBox3.Text) = 0 And Len(ComboBox2.Text) > 0 Then
        '查找大类
        temp = ComboBox2.Text
        Dim stRow&, edRow&, strList
        stRow = Sheets("引用").Range("A:A").Find(temp, Sheets("引用").Range("A2"), , , , xlNext).Row
        edRow = Sheets("引用").Range("A:A").Find("*", Sheets("引用").Range("A" & stRow), , , , xlNext).Row - 1
        If edRow < stRow Then edRow = Sheets("引用").Range("B65536").End(xlUp).Row
        strList = Join(Application.Transpose(Sheets("引用").Range("B" & stRow & ":B" & edRow)), """,""")
        strTJ = strTJ & " and 具体名称 in " & "(""" & strList & """)"
    End If
    '设定日期条件
    If CheckBox2.Value = True Then
        '两个日期都要填写
        If Len(TextBox1.Text) * Len(TextBox2.Text) > 0 Then
            strTJ = strTJ & " and 日期>=#" & TextBox1.Text & "# and 日期<=#" & TextBox2.Text & "#"
        Else
            MsgBox "日期没有填写完整"
            TextBox1.SetFocus
            Exit Sub
        End If
    End If
    '若有条件，则添加条件
    If Len(strTJ) > 0 Then
        SQL = "select * from (" & SQL & ") where " & Right(strTJ, Len(strTJ) - 5)
    End If
    '打开连接
    adoCN.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & ThisWorkbook.FullName & _
            ";Extended Properties=Excel 8.0"
    
    Sheets("结果显示").Range("A2").CopyFromRecordset adoCN.Execute(SQL)
    '关闭连接
    adoCN.Close
    '写入listbox1中,及各种显示
    Call 列表框显示
    Call 显示数值
    If Len(ComboBox3.Text) = 0 Then
        Call 各种
    Else
        Call 单位名称
    End If
End Sub

问题:
一:表二中B列的单元格格式设定好文本,一经查询后又会变成日期格式,什么原因?    这个原因倒是不清楚
二:在物品分类中选择电脑查询,具体名称中出现的却是各种笔                                已经修正
三:不输入任何条件进行"开始查询",列表中具体名称列中凡是电脑类的都无显示.      因为电脑的具体类型字段是数字，而这个SQL查询的时候都是按照文本进行查询的。建议在输入具体数据的时候在那些电脑类的具体类型数字前都加一个半角的单引号。例如 '586
四:什么情况下出现"未选定表格"?不是可以按所有产品查询的吗?                           当按单个表进行查询（即第一个勾去掉，这个是你自己设定的功能哦，我在这里加入了查错判断功能），但是却没有在Combobox1中选择表格的时候会出现。

zzk386

版主,修改的程序试了一下,老问题已解决了,非常好!

另外又发现一个问题,是我设计的时候考虑欠缺所至,情况是这样的:

查询窗口中姓名复合框列出了引用表中D列的姓名.可是在输入数据(另外的窗体)时,不一定是输入引用表中已有的姓名,也可能是其它姓名,如果用姓名为条件查,这个姓名就查不到了,所以想请版主改动一下,凡是用到姓名为条件的,就到"结果显示,界面,帮助,引用"四个表以外的所有表中去查,

不知这样改是否要推倒重来,真不好意思.....[em04][em04][em04]

amulee

这个改起来很方便，就加了一句语句

Private Sub CommandButton2_Click() '主查询按钮
    On Error Resume Next
    Sheets("结果显示").Visible = 2 '隐藏“结果显示”工作表
    Sheets("结果显示").Rows("2:65536") = "" '清空
    CommandButton4.Caption = "显示查询结果"
    '建立ADO查询
    Dim adoCN As Object, i As Integer
    Dim SQL As String, strTJ As String, temp As String
    Dim MySht As Worksheet
    Set adoCN = CreateObject("ADODB.Connection")
    '设定SQL
    If CheckBox1.Value = True Or Len(ComboBox5.Value) > 0 Then
        For Each MySht In Worksheets
            If MySht.Name <> "结果显示" And MySht.Name <> "界面" _
                And MySht.Name <> "帮助" And MySht.Name <> "引用" Then
                
                SQL = SQL & " Union all select " & MySht.Name & ",* from [" & MySht.Name & "$]"
                
            End If
        Next
        SQL = Right(SQL, Len(SQL) - 11)
    Else
        If ComboBox1.Value <> "" Then
            SQL = "select " & ComboBox1.Value & ",* from [" & ComboBox1.Value & "$]"
        Else
            MsgBox "未选择表格"
            Exit Sub
        End If
    End If
    '设定条件
    For i = 3 To 5
        temp = UserForm2.Controls("Combobox" & i).Value
        If Len(temp) > 0 Then
            strTJ = strTJ & " and " & UserForm2.Controls("Label" & i + 2).Caption & "=""" & temp & """"
        End If
    Next i
    '设定物品查询条件。如果没有具体名称则按照大类查找
    If Len(ComboBox3.Text) = 0 And Len(ComboBox2.Text) > 0 Then
        '查找大类
        temp = ComboBox2.Text
        Dim stRow&, edRow&, strList
        stRow = Sheets("引用").Range("A:A").Find(temp, Sheets("引用").Range("A2"), , , , xlNext).Row
        edRow = Sheets("引用").Range("A:A").Find("*", Sheets("引用").Range("A" & stRow), , , , xlNext).Row - 1
        If edRow < stRow Then edRow = Sheets("引用").Range("B65536").End(xlUp).Row
        strList = Join(Application.Transpose(Sheets("引用").Range("B" & stRow & ":B" & edRow)), """,""")
        strTJ = strTJ & " and 具体名称 in " & "(""" & strList & """)"
    End If
    '设定日期条件
    If CheckBox2.Value = True Then
        '两个日期都要填写
        If Len(TextBox1.Text) * Len(TextBox2.Text) > 0 Then
            strTJ = strTJ & " and 日期>=#" & TextBox1.Text & "# and 日期<=#" & TextBox2.Text & "#"
        Else
            MsgBox "日期没有填写完整"
            TextBox1.SetFocus
            Exit Sub
        End If
    End If
    '若有条件，则添加条件
    If Len(strTJ) > 0 Then
        SQL = "select * from (" & SQL & ") where " & Right(strTJ, Len(strTJ) - 5)
    End If
    '打开连接
    adoCN.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & ThisWorkbook.FullName & _
            ";Extended Properties=Excel 8.0"
    
    Sheets("结果显示").Range("A2").CopyFromRecordset adoCN.Execute(SQL)
    '关闭连接
    adoCN.Close
    '写入listbox1中,及各种显示
    Call 列表框显示
    Call 显示数值
    If Len(ComboBox3.Text) = 0 Then
        Call 各种
    Else
        Call 单位名称
    End If
End Sub

zzk386

不好意思,没看出来版主加的是那一条

我上面的表达可能不清楚,意思是姓名复合框下拉列表中不用"引用"表中D列的姓名,而是四个表以外所有表F列中不重复的姓名

 

[em04]

amulee

那就要修改那个组合框的Click事件

zzk386

QUOTE:

以下是引用amulee在2010-1-26 15:50:00的发言：
那就要修改那个组合框的Click事件

对,就是这个意思呢,请版主写一个,这样全部功能都可以完成了.