【VBA案例008】多条件查询

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38

Sub 方法一()

    Dim i, j, k
    Dim ar, br()

    With Sheet2
        ar = .Range("a1:f" & .[a65536].End(3).Row)
    End With

    ReDim br(1 To UBound(ar), 1 To UBound(ar, 2))

    Dim customer, product, startDate As Date, endDate As Date
    With Sheet1
        customer = IIf(.[b2] = "", "", "," & .[b2] & ",")
        product = IIf(.[d2] = "", "", "," & .[d2] & ",")
        startDate = IIf(.[f2] = "", #1/1/1900#, .[f2])
        endDate = IIf(.[h2] = "", #1/1/2400#, .[h2])
    End With

    For i = 2 To UBound(ar)
        If ar(i, 1) >= startDate And ar(i, 1) <= endDate Then
            If InStr("," & ar(i, 2) & ",", customer) > 0 Then
                If InStr("," & ar(i, 3) & ",", product) > 0 Then
                    k = k + 1
                    For j = 1 To UBound(br, 2)
                        br(k, j) = ar(i, j)
                    Next j
                End If
            End If
        End If
    Next i

    Sheet1.[a5:f65536].ClearContents
    If k > 0 Then
        Sheet1.[a5].Resize(k, UBound(br, 2)) = br
    End If

End Sub

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39

Sub SQL查询()
    '定义变量
    Dim cnn, rst, SQL$
    Dim i, j, k
    Set cnn = CreateObject("adodb.connection") '创建数据库连接
    Set rst = CreateObject("adodb.recordset") '创建一个数据集保存数据

    '设置数据库连接
    If Val(Application.Version) < 12 Then
        cnn.Open "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties='Excel 8.0;HDR=yes';Data Source=" & ThisWorkbook.FullName
    Else
        cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0;HDR=yes';Data Source=" & ThisWorkbook.FullName
    End If

    Dim customer, product, startDate As Date, endDate As Date
    With Sheet1
        customer = IIf(.[b2] = "", "", "," & .[b2] & ",")
        product = IIf(.[d2] = "", "", "," & .[d2] & ",")
        startDate = IIf(.[f2] = "", #1/1/1900#, .[f2])
        endDate = IIf(.[h2] = "", #1/1/2400#, .[h2])
    End With

    '设置SQL语句
    SQL = "select * from [产品信息$A1:F22] where 日期>=#" & startDate & "# and 日期<=#" & endDate & "# and instr(','&客户&',','" & customer & "')>0 and instr(','&产品&',','" & product & "')>0" '

    'SQL结果处理
    Set rst = cnn.Execute(SQL)

    Sheet1.[a5:f65536].ClearContents
    Sheet1.Range("a5").CopyFromRecordset rst
'    For i = 1 To rst.Fields.Count
'        Cells(1, i + 5) = rst.Fields(i - 1).Name
'    Next

    rst.Close
    cnn.Close '关闭数据库连接
    Set rst = Nothing
    Set cnn = Nothing '将cnn从内存中删除
End Sub