幫助使用多個文件的excel宏

Question

我有兩個帶有相關數據的excel文件。 我試圖創建一個宏，它將能夠從db.xls中查詢數據並使用正確的值填充data.xls。

希望圖像能夠不言自明。

我沒有使用Excel宏到現在爲止，所以任何建議表示讚賞。

謝謝， 亞歷

Answer 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 

的connecttion處理機

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 

的d測試儀

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

測試儀

---

希望這有助於被調用。