我有两个带有相关数据的excel文件。 我正在尝试创建一个宏,它将能够从db.xls查询数据并使用正确的值填充data.xls。
希望图像不言自明。
到目前为止我没有使用excel宏,所以任何建议都值得赞赏。
谢谢, 亚历
答案 0 :(得分:1)
核心功能
Private Function GetValues(dataFilePath$, dbFilePath$) As String
'///add a reference
'1. Microsoft ActiveX Data Objects 2.8 Library
Dim cn1 As New ADODB.Connection, cn2 As New ADODB.Connection
Dim rs1 As New ADODB.Recordset, rs2 As New ADODB.Recordset
Dim resultstring$, pos&, sql$
Call dbConnect_xls(cn1, dataFilePath)
Call dbConnect_xls(cn2, dbFilePath)
Set rs1 = cn1.Execute("select *from [Sheet1$];")
While Not rs1.EOF
sql = "select *from [sheet1$] where type='" & rs1.Fields(0).Value & "';"
Set rs2 = cn2.Execute(sql)
While Not rs2.EOF
Dim rcount&, tmp$
rcount = rs2.Fields.Count
For pos = 0 To rcount - 1
tmp = tmp & vbTab & rs2.Fields(pos).Value
Next
resultstring = resultstring & tmp & vbCrLf
tmp = ""
rs2.MoveNext
Wend
rs2.Close
rs1.MoveNext
Wend
rs1.Close
cn1.Close
cn2.Close
GetValues = resultstring
End Function
连接处理程序
Private Function dbConnect_xls(dbConn As ADODB.Connection, dbPath As String) As Boolean
On Error GoTo dsnErr
With dbConn
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbPath & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"
.Open
End With
dbConnect_xls = True
Exit Function
dsnErr:
Err.Clear
If dbConn.State > 0 Then dbConn.Close: Call dbConnect_xls(dbConn, dbPath)
dbConnect_xls = False
End Function
和测试人员
Public Sub tester()
Dim d1$, d2$
d1 = InputBox("Enter datafile path:")
d2 = InputBox("Enter dbfile path:")
If Dir(d1) <> "" And Dir(d2) <> "" Then
Dim x$
x = GetValues(d1, d2)
MsgBox x
'Call GetValues("C:\data.xls", "C:\db.xls")
Else
MsgBox "Invalid path provided."
End If
End Sub
,可以从immediate window
测试
希望这有帮助。