Sub querry()
Dim cnn As Object
Dim rst1, rst2 As Object
Dim sql1, sql2, cnnstr As String
Dim erow1, erow2, i, i1, iCount As Integer
Dim sTJ As Boolean
Set cnn = CreateObject("adodb.connection")
Set rst1 = CreateObject("adodb.recordset")
Set rst2 = CreateObject("adodb.recordset")
'cnnstr = "Provider = microsoft.ACE.oledb.12.0;Extended Properties=Excel 12.0;data source= " & ThisWorkbook.FullName 'EXCEL 2007
cnnstr = "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName 'EXCEL 2003
cnn.Open cnnstr
erow1 = Sheets("退货汇总表").Range("A2").CurrentRegion.Rows.Count
erow2 = Sheets("合格汇总表").Range("A2").CurrentRegion.Rows.Count
sql1 = " select * from [退货汇总表$A2:T" & erow1 & "]"
sql2 = " select * from [合格汇总表$A2:Q" & erow2 & "]"
rst1.Open sql1, cnn, 1, 1 '退货汇总表
rst2.Open sql2, cnn, 1, 1 '合格汇总表
With Sheets("查询")
iCount = Range("A" & Rows.Count).End(xlUp).Row
If iCount > 6 Then .Range("A6:" & "P" & iCount).ClearContents
i = 6
While Not (rst2.EOF) '合格品
sTJ = True
If Trim(UCase(.Cells(2, "A"))) <> "" Then
sTJ = sTJ And Trim(UCase(.Cells(2, "A"))) = Trim(UCase(rst2("物料编号"))) End If
If Trim(UCase(.Cells(2, "B"))) <> "" Then
sTJ = sTJ And Trim(UCase(.Cells(2, "B"))) = Trim(UCase(rst2("供货厂家"))) End If
If Trim(UCase(.Cells(2, "C"))) <> "" Then
sTJ = sTJ And CDate(.Cells(2, "C")) = CDate(rst2("采购时间"))
End If
If Evaluate(sTJ) = True Then
For i1 = 1 To 6
.Cells(i, i1) = rst2(i1 - 1)
Next i1
.Cells(i, 7) = rst2("采购时间")
.Cells(i, "I") = rst2("合格数量")
.Cells(i, "K") = rst2("入库数量")
.Cells(i, "M") = rst2("挂帐数量")
i = i + 1
End If
rst2.movenext
Wend
iCount = .Range("A" & Rows.Count).End(xlUp).Row
For i = 6 To iCount
rst1.movefirst
While Not (rst1.EOF)
If Trim(UCase(.Cells(i, "A"))) = Trim(UCase(rst1("物料编号"))) And _
Trim(UCase(.Cells(i, "F"))) = Trim(UCase(rst1("供货厂家"))) And _
CDate(.Cells(i, "G")) = CDate(rst1("采购时间")) Then
.Cells(i, "H") = rst1("采购数量")
.Cells(i, "O") = rst1("实际退货数量")
.Cells(i, "P") = rst1("待退货数量")
.Cells(i, "J").Formula = "=" & .Cells(i, "H").Address(0, 0) & "-" & .Cells(i, "I").Address(0, 0)
.Cells(i, "L").Formula = "=" & .Cells(i, "I").Address(0, 0) & "-" & .Cells(i, "K").Address(0, 0)
.Cells(i, "N").Formula = "=" & .Cells(i, "K").Address(0, 0) & "-" & .Cells(i, "M").Address(0, 0)
End If
rst1.movenext
Wend
Next i
End With
rst1.Close
rst2.Close
cnn.Close
Set rst1 = Nothing
Set rst2 = Nothing
Set cnn = Nothing
End Sub