|
本帖最后由 duquancai 于 2018-4-6 15:25 编辑
修改如下:
Sub test()
Dim sql$, q As Range, r&, sh As Worksheet, fg As Boolean
Sheets("结果").[a1].CurrentRegion.Offset(3).Clear
For Each sh In Worksheets
If sh.Name <> "结果" Then
If Not fg Then
sql = "select * from [" & sh.Name & "$A4:J] where f3 like '%垫片%' or f3 like '%压板%'"
Set q = Sheets("结果").Range("a4"): fg = True
Call SqCopy(sql, q)
Else
r = Sheets("结果").Cells(Sheets("结果").Rows.Count, 1).End(3).Row + 1
sql = "select * from [" & sh.Name & "$A4:J] where f3 like '%垫片%' or f3 like '%压板%'"
Set q = Sheets("结果").Range("a" & r)
Call SqCopy(sql, q)
End If
End If
Next
End Sub
Sub SqCopy(sq As String, Rg As Range)
Dim conn As Object, rst As Object
Set conn = CreateObject("adodb.connection")
Set rst = CreateObject("ADODB.recordset")
If Application.Version * 1 <= 11 Then
conn.Open "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties='excel 8.0;hdr=no';data source=" & ThisWorkbook.FullName
ElseIf Application.Version * 1 >= 12 Then
conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;extended properties='excel 12.0;hdr=no';data source=" & ThisWorkbook.FullName
End If
Set rst = conn.Execute(sq)
Rg.CopyFromRecordset rst
End Sub
|
评分
-
2
查看全部评分
-
|