[已解决]求助！VBA多条件查询数据？？

freexun_zp

老师们！ 你们好！
            最近遇见一个难题，怎么想也想不通，故来请老师们帮忙解惑，非常感谢！！‘
问题是这样的:
       1.       我要做一个VBA多条件查询EXCEL中原始数据资料,需要查询条件有日期时间,工号,姓名（如附件）。
             但是条件中有一个日期，时间起始条件, 原始资料中日期时间在EXCEL中的不同列显示，如何使用VBA查询时让原始数据资料中的日期时间合并并且达到需要查询资料？？？（不修改原始资料）

      2.条件查询时有部分人员,工号是不需要提取的，如何让VBA查询时避开那部分人员(人员清单在表2) 达到查询要求？？

以上求助各位老师帮忙解答,学生万分感谢！！！

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-12-29 15:32

改进下，查询的日期时间可有可无，条件任意组合。

1. Option Explicit
   
2. Const adUseClient = 3
   
3. Const adModeRead = 1
   
4. Const adStateOpen = 1
   
5. Dim AdoConn As Object, AdoRst As Object
   
6. Function OpenConnect(strFullname) As Boolean
   
7. '---------------------------------------------------------------------------------------
   
8. ' Procedure : OpenConnect
   
9. ' Author    : hwc2ycy
   
10. ' Date      : 2013-12-29
    
11. ' Purpose   : 建立数据链接，链接成功则返回TRUE，再次执行时，如果链接正常则不再重新建立。
    
12. '---------------------------------------------------------------------------------------
    
13. '
    
14.     Dim StrConn$
    
15.     On Error GoTo ErrorHandler
    
16.     If Not AdoConn Is Nothing Then
    
17.         If (AdoConn.State And adStateOpen) = adStateOpen Then
    
18.             OpenConnect = True
    
19.             Exit Function
    
20.         Else
    
21.             Set AdoConn = Nothing
    
22.         End If
    
23.     End If
    
24. 
    
25.     Set AdoConn = CreateObject("ADODB.Connection")
    
26.     Select Case Application.Version
    
27.         Case "14.0", "12.0", "16.0"
    
28.             StrConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source='" & _
    
29.                       strFullname & "';Extended Properties='Excel 12.0;HDR=YES" & ";imex=1';"
    
30.         Case Else
    
31.             StrConn = "Provider= Microsoft.Jet.OLEDB.4.0;" & _
    
32.                       "Data Source='" & strFullname & "';Extended Properties='Excel 8.0;HDR=YES" & ";imex=1';"
    
33.     End Select
    
34. 
    
35.     With AdoConn
    
36.         .CommandTimeout = 5    '命令超时
    
37.         .ConnectionTimeout = 5  '连接超时
    
38.         .CursorLocation = adUseClient   '光标类型
    
39.         .Mode = adModeRead  '模式
    
40.         .ConnectionString = StrConn
    
41.         .Open
    
42.     End With
    
43.     OpenConnect = True
    
44.     Exit Function
    
45. ErrorHandler:
    
46.     MsgBox Err.Number & vbCrLf & Err.Description
    
47.     Set AdoRst = Nothing
    
48. End Function
    
49. 
    
50. Sub Main()
    
51.     Dim strDatabase$
    
52.     Dim strSQL$, strID$, strName$
    
53.     Dim strSubSQL$, strDate$
    
54.     On Error GoTo ErrorHandler
    
55.     strDatabase = ThisWorkbook.FullName
    
56.     With Worksheets("异常人员查询")
    
57. 
    
58.         If Not OpenConnect(strDatabase) Then
    
59.             MsgBox "访问 " & strDatabase & " 失败" & vbCrLf & _
    
60.                    "确定退出", vbCritical + vbOKOnly
    
61.             Exit Sub
    
62.         End If
    
63.         '建立连接
    
64. 
    
65.         Set AdoRst = CreateObject("adodb.recordset")
    
66.         strSQL = "select 單位名稱,班別,人員,工號,姓名,卡鐘代號,卡鐘位置,`進/出`,狀態,刷卡日期,時間,卡號 from [系統導出的出勤資料$a1:n" & Worksheets("系統導出的出勤資料").Cells(Rows.Count, 1).End(xlUp).Row & "] where "
    
67. 
    
68.         If Len(.Range("c3").Value) Then
    
69.             strDate = "刷卡日期+時間>=#" & .Range("c3").Value & "# and "
    
70.             '日期起始时间
    
71.         End If
    
72. 
    
73.         If Len(.Range("f3").Value) Then
    
74.             strDate = strDate & "刷卡日期+時間<=#" & .Range("f3").Value & "# and "
    
75.             '日期结束时间
    
76.         End If
    
77.         
    
78.         strSQL = strSQL & strDate
    
79.         '此种语句下要求C3是起始时间，F3是结束时间
    
80.         
    
81.         If Len(.[c5].Value) Then
    
82.             strID = "工號 like '" & .[c5].Value & "' and "
    
83.             '检测是否指定查询工号
    
84.             strSQL = strSQL & strID
    
85.         End If
    
86. 
    
87.         If Len(.[g5].Value) Then
    
88.             strName = "姓名 like '" & .[g5].Value & "' and "
    
89.             '检测是否指定查询姓名
    
90.             strSQL = strSQL & strName
    
91.         End If
    
92. 
    
93.         strSubSQL = "工號 not in (select 工號 from [不需要計算的人員$a1:a" & Worksheets("不需要計算的人員").Cells(Rows.Count, 1).End(xlUp).Row & "])"
    
94.         '嵌套查询，检测工号是号在排除名单之中
    
95. 
    
96.         strSQL = strSQL & strSubSQL
    
97.         'Debug.Print strSQL
    
98.         AdoRst.Open strSQL, AdoConn, 2, 1
    
99. 
    
100.         MsgBox "完成" & vbCrLf & "一共　" & AdoRst.RecordCount & " 条记录"
     
101.         Application.ScreenUpdating = False
     
102.         If .Cells(Rows.Count, 2).End(xlUp).Row > 9 Then
     
103.             .Range("b9:m" & .Cells(Rows.Count, 2).End(xlUp).Row).ClearContents
     
104.         End If
     
105.         '清空单元格中原有内容
     
106.         .Range("b9").CopyFromRecordset AdoRst
     
107.         '查询结果写入单元格中
     
108.         .Columns("l").NumberFormatLocal = "[$-F400]h:mm:ss AM/PM"
     
109.         'L列格式调整为时间
     
110.         Application.ScreenUpdating = True
     
111.     End With
     
112.     AdoRst.Close
     
113.     Exit Sub
     
114. ErrorHandler:
     
115.     MsgBox Err.Number & vbCrLf & _
     
116.            Err.Description
     
117.     AdoConn.Close
     
118.     Set AdoConn = Nothing
     
119. End Sub

复制代码

跳转到最佳答案楼层

danio112

哈哈，看来不需要查询的人肯定就是领导了

sliang28

把你查询的情况说详细一点,免得别人少写了.
比如说:按时间查\按时间和工号查\按时间姓名查\按工号查\按姓名查

hwc2ycy

1. Option Explicit
   
2. 
   
3. Const adUseClient = 3
   
4. Const adModeShareDenyWrite = 8
   
5. Const adModeReadWrite = 3
   
6. Const adModeRead = 1
   
7. 
   
8. Dim AdoConn As Object, AdoRst As Object
   
9. 
   
10. Function OpenConnect(strFullname) As Boolean
    
11.     Dim StrConn$
    
12. 
    
13.     On Error GoTo ErrorHandler
    
14.     If AdoConn Is Nothing Then
    
15.         Set AdoConn = CreateObject("ADODB.Connection")
    
16.     Else
    
17.         OpenConnect = True
    
18.         Exit Function
    
19.     End If
    
20. 
    
21.     Select Case Application.Version
    
22.         Case "14.0", "12.0", "16.0"
    
23.             StrConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source='" & _
    
24.                       strFullname & "';Extended Properties='Excel 12.0;HDR=YES" & ";imex=1';"
    
25.         Case Else
    
26.             StrConn = "Provider= Microsoft.Jet.OLEDB.4.0;" & _
    
27.                       "Data Source='" & strFullname & "';Extended Properties='Excel 8.0;HDR=YES" & ";imex=1';"
    
28.     End Select
    
29. 
    
30.     With AdoConn
    
31.         .CommandTimeout = 5
    
32.         .ConnectionTimeout = 5
    
33.         .CursorLocation = adUseClient
    
34.         .Mode = adModeRead
    
35.         .ConnectionString = StrConn
    
36.         .Open
    
37.     End With
    
38. 
    
39.     OpenConnect = True
    
40.     Exit Function
    
41. 
    
42. ErrorHandler:
    
43.     MsgBox Err.Number & vbCrLf & Err.Description
    
44.     Set AdoRst = Nothing
    
45.     Set AdoConn = Nothing
    
46. 
    
47. End Function
    
48. 
    
49. Sub Main()
    
50.     Dim strDatabase$
    
51.     Dim strSQL$
    
52. 
    
53.     On Error GoTo ErrorHandler
    
54. 
    
55.     strDatabase = ThisWorkbook.FullName
    
56.     With Worksheets("异常人员查询")
    
57.         If Len(.Range("c3")) = 0 Or Len(.Range("f3").Value) = 0 Then
    
58.             MsgBox "C3,F3单元格为必填字段"
    
59.             Exit Sub
    
60.         End If
    
61. 
    
62.         If Not OpenConnect(strDatabase) Then
    
63.             MsgBox "访问 " & strDatabase & " 失败" & vbCrLf & _
    
64.                    "确定退出", vbCritical + vbOKOnly
    
65.             Exit Sub
    
66.         End If
    
67. 
    
68. 
    
69.         Set AdoRst = CreateObject("adodb.recordset")
    
70. 
    
71.         strSQL = "select 單位名稱,班別,人員,工號,姓名,卡鐘代號,卡鐘位置,`進/出`,狀態,刷卡日期,timevalue(時間),卡號 from [系統導出的出勤資料$]"
    
72.         Dim strDate$
    
73.         strDate = "(cdate(刷卡日期+時間)  between #" & [c3].Value & "# and #" & [f3].Value & "#)"
    
74.         Dim strID$, strName$
    
75.         strID = "工號 like '" & IIf(Len(.[c5].Value) = 0, "%", .[c5].Value) & "'"
    
76.         strName = "姓名 like '" & IIf(Len(.[g5].Value) = 0, "%", .[g5].Value) & "'"
    
77.         Dim strSubSql$
    
78.         strSubSql = "select 工號 from [不需要計算的人員$]"
    
79.         strSQL = strSQL & " where " & strDate & " and " & strID & " and " & strName & " and  工號 not in (" & strSubSql & ")"
    
80.         Debug.Print strSQL
    
81.         AdoRst.Open strSQL, AdoConn, 2, 1
    
82. 
    
83.         With AdoRst
    
84.             MsgBox "完成" & vbCrLf & "一共　" & .RecordCount & " 条记录"
    
85.         End With
    
86. 
    
87.         If .Cells(Rows.Count, 2).End(xlUp).Row > 9 Then
    
88.             .Rows("9:" & .Cells(Rows.Count, 2).End(xlUp).Row).Clear
    
89.         End If
    
90. 
    
91.         .Range("b9").CopyFromRecordset AdoRst
    
92.         .Columns("l").NumberFormatLocal = "[$-F400]h:mm:ss AM/PM"
    
93. 
    
94.     End With
    
95.     Set AdoRst = Nothing
    
96.     Exit Sub
    
97. 
    
98. ErrorHandler:
    
99.     MsgBox Err.Number & vbCrLf & _
    
100.            Err.Description
     
101.     AdoConn.Close
     
102.     Set AdoConn = Nothing
     
103. End Sub
     

复制代码

hwc2ycy

1. Const adUseClient = 3
   
2. Const adModeRead = 1
   
3. 
   
4. Dim AdoConn As Object, AdoRst As Object
   
5. 
   
6. Function OpenConnect(strFullname) As Boolean
   
7.     Dim StrConn$
   
8. 
   
9.     On Error GoTo ErrorHandler
   
10.     If AdoConn Is Nothing Then
    
11.         Set AdoConn = CreateObject("ADODB.Connection")
    
12.     Else
    
13.         OpenConnect = True
    
14.         Exit Function
    
15.     End If
    
16. 
    
17.     Select Case Application.Version
    
18.         Case "14.0", "12.0", "16.0"
    
19.             StrConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source='" & _
    
20.                       strFullname & "';Extended Properties='Excel 12.0;HDR=YES" & ";imex=1';"
    
21.         Case Else
    
22.             StrConn = "Provider= Microsoft.Jet.OLEDB.4.0;" & _
    
23.                       "Data Source='" & strFullname & "';Extended Properties='Excel 8.0;HDR=YES" & ";imex=1';"
    
24.     End Select
    
25. 
    
26.     With AdoConn
    
27.         .CommandTimeout = 5
    
28.         .ConnectionTimeout = 5
    
29.         .CursorLocation = adUseClient
    
30.         .Mode = adModeRead
    
31.         .ConnectionString = StrConn
    
32.         .Open
    
33.     End With
    
34. 
    
35.     OpenConnect = True
    
36.     Exit Function
    
37. 
    
38. ErrorHandler:
    
39.     MsgBox Err.Number & vbCrLf & Err.Description
    
40.     Set AdoRst = Nothing
    
41.     Set AdoConn = Nothing
    
42. 
    
43. End Function
    
44. 
    
45. Sub Main()
    
46.     Dim strDatabase$
    
47.     Dim strSQL$
    
48.     Dim strID$, strName$
    
49.     Dim strSubSql$
    
50.     Dim strDate$
    
51.     On Error GoTo ErrorHandler
    
52. 
    
53.     strDatabase = ThisWorkbook.FullName
    
54.     With Worksheets("异常人员查询")
    
55.         If Len(.Range("c3")) = 0 Or Len(.Range("f3").Value) = 0 Then
    
56.             MsgBox "C3,F3单元格为必填字段"
    
57.             Exit Sub
    
58.         End If
    
59. 
    
60.         If Not OpenConnect(strDatabase) Then
    
61.             MsgBox "访问 " & strDatabase & " 失败" & vbCrLf & _
    
62.                    "确定退出", vbCritical + vbOKOnly
    
63.             Exit Sub
    
64.         End If
    
65. 
    
66. 
    
67.         Set AdoRst = CreateObject("adodb.recordset")
    
68. 
    
69.         strSQL = "select 單位名稱,班別,人員,工號,姓名,卡鐘代號,卡鐘位置,`進/出`,狀態,刷卡日期,timevalue(時間),卡號 from [系統導出的出勤資料$]"
    
70. 
    
71.         'strDate = "(cdate(刷卡日期+時間)  between #" & .[c3].Value & "# and #" & .[f3].Value & "#)"
    
72.         strDate = "(刷卡日期+時間 between #" & .[c3].Value & "# and #" & .[f3].Value & "#)"
    
73. 
    
74.         strID = "工號 like '" & IIf(Len(.[c5].Value) = 0, "%", .[c5].Value) & "'"
    
75.         strName = "姓名 like '" & IIf(Len(.[g5].Value) = 0, "%", .[g5].Value) & "'"
    
76.         strSubSql = "select 工號 from [不需要計算的人員$]"
    
77.         strSQL = strSQL & " where " & strDate & " and " & strID & " and " & strName & " and  工號 not in (" & strSubSql & ")"
    
78.         'Debug.Print strSQL
    
79.         AdoRst.Open strSQL, AdoConn, 2, 1
    
80. 
    
81.         MsgBox "完成" & vbCrLf & "一共　" & AdoRst.RecordCount & " 条记录"
    
82.         Application.ScreenUpdating = False
    
83.         
    
84.         If .Cells(Rows.Count, 2).End(xlUp).Row > 9 Then
    
85.             .Range("b9:m" & .Cells(Rows.Count, 2).End(xlUp).Row).ClearContents
    
86.         End If
    
87. 
    
88.         .Range("b9").CopyFromRecordset AdoRst
    
89.         .Columns("l").NumberFormatLocal = "[$-F400]h:mm:ss AM/PM"
    
90.         Application.ScreenUpdating = True
    
91.     End With
    
92.     Set AdoRst = Nothing
    
93.     Exit Sub
    
94. 
    
95. ErrorHandler:
    
96.     MsgBox Err.Number & vbCrLf & _
    
97.            Err.Description
    
98.     AdoConn.Close
    
99.     Set AdoConn = Nothing
    
100. End Sub

复制代码

hwc2ycy

查询的数据列数定好。

1. Option Explicit
   
2. Const adUseClient = 3
   
3. Const adModeRead = 1
   
4. Dim AdoConn As Object, AdoRst As Object
   
5. Function OpenConnect(strFullname) As Boolean
   
6.     Dim StrConn$
   
7.     On Error GoTo ErrorHandler
   
8.     If AdoConn Is Nothing Then
   
9.         Set AdoConn = CreateObject("ADODB.Connection")
   
10.     Else
    
11.         OpenConnect = True
    
12.         Exit Function
    
13.     End If
    
14. 
    
15.     Select Case Application.Version
    
16.         Case "14.0", "12.0", "16.0"
    
17.             StrConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source='" & _
    
18.                       strFullname & "';Extended Properties='Excel 12.0;HDR=YES" & ";imex=1';"
    
19.         Case Else
    
20.             StrConn = "Provider= Microsoft.Jet.OLEDB.4.0;" & _
    
21.                       "Data Source='" & strFullname & "';Extended Properties='Excel 8.0;HDR=YES" & ";imex=1';"
    
22.     End Select
    
23. 
    
24.     With AdoConn
    
25.         .CommandTimeout = 5
    
26.         .ConnectionTimeout = 5
    
27.         .CursorLocation = adUseClient
    
28.         .Mode = adModeRead
    
29.         .ConnectionString = StrConn
    
30.         .Open
    
31.     End With
    
32.     OpenConnect = True
    
33.     Exit Function
    
34. ErrorHandler:
    
35.     MsgBox Err.Number & vbCrLf & Err.Description
    
36.     Set AdoRst = Nothing
    
37.     Set AdoConn = Nothing
    
38. End Function
    
39. 
    
40. Sub Main()
    
41.     Dim strDatabase$
    
42.     Dim strSQL$, strID$, strName$
    
43.     Dim strSubSQL$, strDate$
    
44.     On Error GoTo ErrorHandler
    
45.     strDatabase = ThisWorkbook.FullName
    
46.     With Worksheets("异常人员查询")
    
47.         If Len(.Range("c3")) = 0 Or Len(.Range("f3").Value) = 0 Then
    
48.             MsgBox "C3,F3单元格为必填字段"
    
49.             Exit Sub
    
50.         End If
    
51. 
    
52.         If Not OpenConnect(strDatabase) Then
    
53.             MsgBox "访问 " & strDatabase & " 失败" & vbCrLf & _
    
54.                    "确定退出", vbCritical + vbOKOnly
    
55.             Exit Sub
    
56.         End If
    
57. 
    
58.         Set AdoRst = CreateObject("adodb.recordset")
    
59.         strSQL = "select 單位名稱,班別,人員,工號,姓名,卡鐘代號,卡鐘位置,`進/出`,狀態,刷卡日期,timevalue(時間),卡號 from [系統導出的出勤資料$a:n]"
    
60.         'strDate = "(cdate(刷卡日期+時間)  between #" & .[c3].Value & "# and #" & .[f3].Value & "#)"
    
61.         strDate = "(刷卡日期+時間 between #" & .[c3].Value & "# and #" & .[f3].Value & "#)"
    
62.         strID = "工號 like '" & IIf(Len(.[c5].Value) = 0, "%", .[c5].Value) & "'"
    
63.         strName = "姓名 like '" & IIf(Len(.[g5].Value) = 0, "%", .[g5].Value) & "'"
    
64.         strSubSQL = "select 工號 from [不需要計算的人員$a:b]"
    
65.         strSQL = strSQL & " where " & strDate & " and " & strID & " and " & strName & " and  工號 not in (" & strSubSQL & ")"
    
66.         'Debug.Print strSQL
    
67.         AdoRst.Open strSQL, AdoConn, 2, 1
    
68. 
    
69.         MsgBox "完成" & vbCrLf & "一共　" & AdoRst.RecordCount & " 条记录"
    
70.         Application.ScreenUpdating = False
    
71.         If .Cells(Rows.Count, 2).End(xlUp).Row > 9 Then
    
72.             .Range("b9:m" & .Cells(Rows.Count, 2).End(xlUp).Row).ClearContents
    
73.         End If
    
74.         .Range("b9").CopyFromRecordset AdoRst
    
75.         .Columns("l").NumberFormatLocal = "[$-F400]h:mm:ss AM/PM"
    
76.         Application.ScreenUpdating = True
    
77.     End With
    
78.     Set AdoRst = Nothing
    
79.     Exit Sub
    
80. ErrorHandler:
    
81.     MsgBox Err.Number & vbCrLf & _
    
82.            Err.Description
    
83.     AdoConn.Close
    
84.     Set AdoConn = Nothing
    
85. End Sub

复制代码

hwc2ycy

改进下，查询的日期时间可有可无，条件任意组合。

1. Option Explicit
   
2. Const adUseClient = 3
   
3. Const adModeRead = 1
   
4. Const adStateOpen = 1
   
5. Dim AdoConn As Object, AdoRst As Object
   
6. Function OpenConnect(strFullname) As Boolean
   
7. '---------------------------------------------------------------------------------------
   
8. ' Procedure : OpenConnect
   
9. ' Author    : hwc2ycy
   
10. ' Date      : 2013-12-29
    
11. ' Purpose   : 建立数据链接，链接成功则返回TRUE，再次执行时，如果链接正常则不再重新建立。
    
12. '---------------------------------------------------------------------------------------
    
13. '
    
14.     Dim StrConn$
    
15.     On Error GoTo ErrorHandler
    
16.     If Not AdoConn Is Nothing Then
    
17.         If (AdoConn.State And adStateOpen) = adStateOpen Then
    
18.             OpenConnect = True
    
19.             Exit Function
    
20.         Else
    
21.             Set AdoConn = Nothing
    
22.         End If
    
23.     End If
    
24. 
    
25.     Set AdoConn = CreateObject("ADODB.Connection")
    
26.     Select Case Application.Version
    
27.         Case "14.0", "12.0", "16.0"
    
28.             StrConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source='" & _
    
29.                       strFullname & "';Extended Properties='Excel 12.0;HDR=YES" & ";imex=1';"
    
30.         Case Else
    
31.             StrConn = "Provider= Microsoft.Jet.OLEDB.4.0;" & _
    
32.                       "Data Source='" & strFullname & "';Extended Properties='Excel 8.0;HDR=YES" & ";imex=1';"
    
33.     End Select
    
34. 
    
35.     With AdoConn
    
36.         .CommandTimeout = 5    '命令超时
    
37.         .ConnectionTimeout = 5  '连接超时
    
38.         .CursorLocation = adUseClient   '光标类型
    
39.         .Mode = adModeRead  '模式
    
40.         .ConnectionString = StrConn
    
41.         .Open
    
42.     End With
    
43.     OpenConnect = True
    
44.     Exit Function
    
45. ErrorHandler:
    
46.     MsgBox Err.Number & vbCrLf & Err.Description
    
47.     Set AdoRst = Nothing
    
48. End Function
    
49. 
    
50. Sub Main()
    
51.     Dim strDatabase$
    
52.     Dim strSQL$, strID$, strName$
    
53.     Dim strSubSQL$, strDate$
    
54.     On Error GoTo ErrorHandler
    
55.     strDatabase = ThisWorkbook.FullName
    
56.     With Worksheets("异常人员查询")
    
57. 
    
58.         If Not OpenConnect(strDatabase) Then
    
59.             MsgBox "访问 " & strDatabase & " 失败" & vbCrLf & _
    
60.                    "确定退出", vbCritical + vbOKOnly
    
61.             Exit Sub
    
62.         End If
    
63.         '建立连接
    
64. 
    
65.         Set AdoRst = CreateObject("adodb.recordset")
    
66.         strSQL = "select 單位名稱,班別,人員,工號,姓名,卡鐘代號,卡鐘位置,`進/出`,狀態,刷卡日期,時間,卡號 from [系統導出的出勤資料$a1:n" & Worksheets("系統導出的出勤資料").Cells(Rows.Count, 1).End(xlUp).Row & "] where "
    
67. 
    
68.         If Len(.Range("c3").Value) Then
    
69.             strDate = "刷卡日期+時間>=#" & .Range("c3").Value & "# and "
    
70.             '日期起始时间
    
71.         End If
    
72. 
    
73.         If Len(.Range("f3").Value) Then
    
74.             strDate = strDate & "刷卡日期+時間<=#" & .Range("f3").Value & "# and "
    
75.             '日期结束时间
    
76.         End If
    
77.         
    
78.         strSQL = strSQL & strDate
    
79.         '此种语句下要求C3是起始时间，F3是结束时间
    
80.         
    
81.         If Len(.[c5].Value) Then
    
82.             strID = "工號 like '" & .[c5].Value & "' and "
    
83.             '检测是否指定查询工号
    
84.             strSQL = strSQL & strID
    
85.         End If
    
86. 
    
87.         If Len(.[g5].Value) Then
    
88.             strName = "姓名 like '" & .[g5].Value & "' and "
    
89.             '检测是否指定查询姓名
    
90.             strSQL = strSQL & strName
    
91.         End If
    
92. 
    
93.         strSubSQL = "工號 not in (select 工號 from [不需要計算的人員$a1:a" & Worksheets("不需要計算的人員").Cells(Rows.Count, 1).End(xlUp).Row & "])"
    
94.         '嵌套查询，检测工号是号在排除名单之中
    
95. 
    
96.         strSQL = strSQL & strSubSQL
    
97.         'Debug.Print strSQL
    
98.         AdoRst.Open strSQL, AdoConn, 2, 1
    
99. 
    
100.         MsgBox "完成" & vbCrLf & "一共　" & AdoRst.RecordCount & " 条记录"
     
101.         Application.ScreenUpdating = False
     
102.         If .Cells(Rows.Count, 2).End(xlUp).Row > 9 Then
     
103.             .Range("b9:m" & .Cells(Rows.Count, 2).End(xlUp).Row).ClearContents
     
104.         End If
     
105.         '清空单元格中原有内容
     
106.         .Range("b9").CopyFromRecordset AdoRst
     
107.         '查询结果写入单元格中
     
108.         .Columns("l").NumberFormatLocal = "[$-F400]h:mm:ss AM/PM"
     
109.         'L列格式调整为时间
     
110.         Application.ScreenUpdating = True
     
111.     End With
     
112.     AdoRst.Close
     
113.     Exit Sub
     
114. ErrorHandler:
     
115.     MsgBox Err.Number & vbCrLf & _
     
116.            Err.Description
     
117.     AdoConn.Close
     
118.     Set AdoConn = Nothing
     
119. End Sub

复制代码

freexun_zp

hwc2ycy 发表于 2013-12-29 15:32
改进下，查询的日期时间可有可无，条件任意组合。

这代码太多啊
            重要的是那些呢 ？ 求老师解析？VBA不是很好，非常感谢

hwc2ycy

freexun_zp 发表于 2013-12-30 09:41
这代码太多啊
            重要的是那些呢 ？ 求老师解析？VBA不是很好，非常感谢

你会用就成了，主要是利用SQL查询来实现。

freexun_zp

hwc2ycy 发表于 2013-12-30 09:47
你会用就成了，主要是利用SQL查询来实现。

老师你好
    我调试了一下你的代码
                      系统提示错误  如图
excel提示无法打开事件   这是什么问题？求老师帮忙在解答一下  或用附件呈现，非常感谢
        老师提供的代码中除函数公式外其他都能理解   “看公式大概意思应是链接外部数据用的”，这部分不会用
我的excel版本是2003版本的   请在帮一下帮，谢谢！