[已解决]求助，如何根据条件返回查询结果？

蝶·舞 · 发表于 2010-1-7 09:33

根据查询的条件，从数据源中返回符合条件的数据！

bxaa57UZ.zip (10.65 KB, 下载次数: 6)

lotte · 发表于 2010-1-7 09:47

数据源规范的话 QUERY可以做

蝶·舞 · 发表于 2010-1-7 10:22

QUOTE:

以下是引用lotte在2010-1-7 9:47:00的发言：
数据源规范的话 QUERY可以做

帮我做一下啊

lotte · 发表于 2010-1-7 10:32

缺省时，表示所有人员我做不到

期待高手

lotte · 发表于 2010-1-7 10:33

coLUV6wU.rar (10.27 KB, 下载次数: 7)

amulee · 发表于 2010-1-7 10:46

这个最佳答案由 amulee 给出，感谢 amulee 的回答。

单击隐藏图章

按钮自己加了

Sub 查询()
    Dim RowN&, strAdd$, Sql$, i%, Temp$
    Dim AdoCn, AdoRe
    Set AdoCn = CreateObject("ADODB.Connection")
    Set AdoRe = CreateObject("ADODB.Recordset")
    RowN = Sheet1.Range("B65536").End(xlUp).Row
    strAdd = Sheet1.Range("B6:F" & RowN).Address(0, 0)
    '创建连接
    AdoCn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName & _
                ";Extended Properties=Excel 8.0"
    '设定Sql
    For i = 6 To 7
        If Len(Cells(i, 3)) > 0 Then
            Sql = Sql & Cells(i, 2) & "=""" & Cells(i, 3) & """ and "
        End If
    Next i
    If Len(Sql) > 0 Then
        Sql = Left(Sql, Len(Sql) - 5)
        Temp = " and "
    End If
    If Len(Cells(3, 3)) > 0 Then
        Sql = Sql & Temp & "报销人=""" & Cells(3, 3) & """"
    End If
    If Len(Sql) > 0 Then Temp = " and "
    If Len(Cells(4, 3)) > 0 Then
        Sql = Sql & Temp & "日期>=#" & Cells(4, 3) & "#"
    End If
    If Len(Sql) > 0 Then Temp = " and "
    If Len(Cells(5, 3)) > 0 Then
        Sql = Sql & Temp & "日期<=#" & Cells(5, 3) & "#"
    End If
    If Len(Sql) > 0 Then Temp = " where "
    Sql = "SELECT * FROM [数据库$" & strAdd & "]" & Temp & Sql
    '打开纪录集
    AdoRe.Open Source:=Sql, ActiveConnection:=AdoCn
    '复制纪录集到单元格
    Range("B10:G1000").ClearContents
    Range("B10").CopyFromRecordset AdoRe
    '关闭连接
    AdoCn.Close
    Set AdoCn = Nothing
    Set AdoRe = Nothing
End Sub

[此贴子已经被作者于2010-1-7 10:48:31编辑过]

蝶·舞 · 发表于 2010-1-7 14:13

QUOTE:

以下是引用amulee在2010-1-7 10:46:00的发言：

按钮自己加了

Sub 查询()
    Dim RowN&, strAdd$, Sql$, i%, Temp$
    Dim AdoCn, AdoRe
    Set AdoCn = CreateObject("ADODB.Connection")
    Set AdoRe = CreateObject("ADODB.Recordset")
    RowN = Sheet1.Range("B65536").End(xlUp).Row
    strAdd = Sheet1.Range("B6:F" & RowN).Address(0, 0)
    '创建连接
    AdoCn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName & _
                ";Extended Properties=Excel 8.0"
    '设定Sql
    For i = 6 To 7
        If Len(Cells(i, 3)) > 0 Then
            Sql = Sql & Cells(i, 2) & "=""" & Cells(i, 3) & """ and "
        End
  If
    Next i
    If Len(Sql) > 0 Then
        Sql = Left(Sql, Len(Sql) - 5)
        Temp = " and "
    End
  If
    If Len(Cells(3, 3)) > 0 Then
        Sql = Sql & Temp & "报销人=""" & Cells(3, 3) & """"
    End
  If
    If Len(Sql) > 0 Then Temp = " and "
    If Len(Cells(4, 3)) > 0 Then
        Sql = Sql & Temp & "日期>=#" & Cells(4, 3) & "#"
    End
  If
    If Len(Sql) > 0 Then Temp = " and "
    If Len(Cells(5, 3)) > 0 Then
        Sql = Sql & Temp & "日期<=#" & Cells(5, 3) & "#"
    End
  If
    If Len(Sql) > 0 Then Temp = " where "
    Sql = "SELECT * FROM [数据库$" & strAdd & "]" & Temp & Sql
    '打开纪录集
    AdoRe.Open Source:=Sql, ActiveConnection:=AdoCn
    '复制纪录集到单元格
    Range("B10:G1000").ClearContents
    Range("B10").CopyFromRecordset AdoRe
    '关闭连接
    AdoCn.Close
    Set AdoCn = Nothing
    Set AdoRe = Nothing
End
  Sub

阿木帮人帮到底啊，如何再自动添加网络线？

amulee · 发表于 2010-1-7 14:23

Sub 查询()
    Application.ScreenUpdating = True
    Dim RowN&, strAdd$, Sql$, i%, Temp$
    Dim AdoCn, AdoRe
    Set AdoCn = CreateObject("ADODB.Connection")
    Set AdoRe = CreateObject("ADODB.Recordset")
    RowN = Sheet1.Range("B65536").End(xlUp).Row
    strAdd = Sheet1.Range("B6:F" & RowN).Address(0, 0)
    '创建连接
    AdoCn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName & _
                ";Extended Properties=Excel 8.0"
    '设定Sql
    For i = 6 To 7
        If Len(Cells(i, 3)) > 0 Then
            Sql = Sql & Cells(i, 2) & "=""" & Cells(i, 3) & """ and "
        End If
    Next i
    If Len(Sql) > 0 Then
        Sql = Left(Sql, Len(Sql) - 5)
        Temp = " and "
    End If
    If Len(Cells(3, 3)) > 0 Then
        Sql = Sql & Temp & "报销人=""" & Cells(3, 3) & """"
    End If
    If Len(Sql) > 0 Then Temp = " and "
    If Len(Cells(4, 3)) > 0 Then
        Sql = Sql & Temp & "日期>=#" & Cells(4, 3) & "#"
    End If
    If Len(Sql) > 0 Then Temp = " and "
    If Len(Cells(5, 3)) > 0 Then
        Sql = Sql & Temp & "日期<=#" & Cells(5, 3) & "#"
    End If
    If Len(Sql) > 0 Then Temp = " where "
    Sql = "SELECT * FROM [数据库$" & strAdd & "]" & Temp & Sql
    '打开纪录集
    AdoRe.Open Source:=Sql, ActiveConnection:=AdoCn
    '复制纪录集到单元格
    Range("B10:G65536").Clear
    Range("B10").CopyFromRecordset AdoRe
    '关闭连接
    AdoCn.Close
    Set AdoCn = Nothing
    Set AdoRe = Nothing
    '表格边框
    Range("B10:G" & Range("B65536").End(xlUp).Row).Borders.ColorIndex = 7
    Application.ScreenUpdating = True
End Sub

xdwy81129 · 发表于 2010-1-7 23:21

高手出手了。学习看看[em01]

		自动登录	找回密码
密码			注册