vba - 複数のファイルを使用したExcelマクロの支援

Question

関連データを含む2つのExcelファイルがあります。db.xls からデータを照会し、data.xls に適切な値を入力できるマクロを作成しようとしています。

画像が自明であることを願っています。

今までエクセルのマクロを使っていなかったので、アドバイスをいただければ幸いです。

ありがとう、アレックス

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

接続ハンドラー

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

テスター

---

お役に立てれば。