EXCEL VBA RecordSet记录集的使用

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