帮助使用多个文件的Excelmacros

我有两个相关的数据excel文件。 我正在尝试创build一个macros,它将能够从db.xls中查询数据,并使用正确的值填充data.xls。

希望形象不言自明。

在这里输入图像说明

我没有使用Excelmacros,直到现在,所以任何build议表示赞赏。

谢谢,Alex

核心function

 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 

和testing者

 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调用

testing仪


希望这可以帮助。