|
- Sub test()
- Dim cnn As New ADODB.Connection
- Dim rs As New ADODB.Recordset
- Dim sql As String
- Dim mybook As String
- mybook = ThisWorkbook.FullName
- With cnn
- If Application.Version = "11.0" Then
- .Provider = "microsoft.jet.oledb.4.0"
- .ConnectionString = "extended properties=""excel 8.0;HDR=YES;"";data source=" & mybook
- Else
- .Provider = "microsoft.ACE.oledb.12.0"
- .ConnectionString = "extended properties=""excel 12.0;HDR=YES;"";data source=" & mybook
- End If
- .Open
- End With
- With Worksheets("sheet2")
- arr = .Range("b14:e17")
- End With
- tj = ""
- For i = 1 To UBound(arr)
- If Len(arr(i, 2)) <> 0 Then
- Select Case i
- Case 1
- tj = tj & " And " & arr(i, 1) & "='" & arr(i, 2) & "'"
- Case 2
- tj = tj & " And " & arr(i, 1) & " Like '" & arr(i, 2) & "'"
- Case 3
- tj = tj & " And (" & arr(i, 1) & " Between " & arr(i, 2) & " and " & arr(i, 4) & ")"
- Case 4
- tj = tj & " and (" & arr(i, 1) & " Between #" & arr(i, 2) & "# And #" & arr(i, 4) & "#)"
- End Select
- End If
- Next
- If tj = "" Then
- tj = True
- Else
- tj = Mid(tj, 6)
- End If
- sql = "select * from [sheet2$" & Worksheets("sheet2").Range("a1").CurrentRegion.Address(0, 0) & "] where " & tj
- rs.Open sql, cnn, adOpenKeyset, adLockOptimistic
- With Worksheets("sheet3")
- .Cells.Delete
- For j = 0 To rs.Fields.Count - 1
- .Cells(1, j + 1) = rs.Fields(j).Name
- Next
- .Range("a2").CopyFromRecordset rs
- End With
- End Sub
复制代码 |
评分
-
1
查看全部评分
-
|