Question

我有3个数据集。我想组合由ID组织的数据库1和2中的数据，以便我可以在一个地方对所有变量进行分析。在单独的工作表中，我将SSN与ID匹配，但它们不在任何主集上。此外，数据库1和数据库2中的参与者列表不相等。

我的目标是追加数据库1和数据库2，认识到它们代表不同的人群。提前谢谢。

Database1
SSN         CORTISOL    VITAMIN D
123143212   20          112
142342134   11          543

Database2
ID           Rbans      pcl
B1234        43         32
C4325        54         53

Database3
SSN         ID  
123143212   B1234         
142342134   C4325

Answer 1

考虑一个SQL解决方案，因为这是一个简单的内连接查询，Excel VBA可以自己运行SQL，打开的工作簿通过ADO连接到Jet / ACE SQL引擎（Windows .dll文件，通常安装在所有PC机上）

宏下面假设一个工作簿中存在四张： [Database1 $] ， [Database2 $] ， [Database3 $] ，以及一个空白 [结果$ ]，数据列以 A1 单元格开头。

SQL 查询（以字符串形式插入VBA）

SELECT d1.SSN, d2.ID, d1.CORTISOL, 
       d1.[VITAMIN D], d2.Rbans, d2.pcl
FROM (Database3 d3 INNER JOIN Database2 d2 ON d3.ID = d2.ID) 
INNER JOIN Database1 d1 ON d3.SSN = d1.SSN;

VBA 宏（两个连接字符串可用）

Sub RunSQL()

    Dim conn As Object, rst As Object
    Dim strConnection As String, strSQL As String
    Dim i As Integer, fld As Object

    Set conn = CreateObject("ADODB.Connection")
    Set rst = CreateObject("ADODB.Recordset")

     ' STRING VALUES
'    strConnection = "DRIVER={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" _
'                      & "DBQ=C:\Path\To\Workbook.xlsm;"
    strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                       & "Data Source='C:\Path\To\Workbook.xlsm';" _
                       & "Extended Properties=""Excel 8.0;HDR=YES;"";"

    strSQL = "SELECT d1.SSN, d2.ID, d1.CORTISOL," _
           & "       d1.[VITAMIN D], d2.Rbans, d2.pcl" _
           & " FROM ([Database3$] d3 INNER JOIN [Database2$] d2 ON d3.ID = d2.ID)" _
           & " INNER JOIN [Database1$] d1 ON d3.SSN = d1.SSN;" 

    ' OPEN DB CONNECTION AND RECORDSET
    conn.Open strConnection
    rst.Open strSQL, conn

    ' OUTPUT COLUMN HEADERS
    i = 0
    Worksheets("Results").Range("A1").Activate
    For Each fld In rst.Fields
        ActiveCell.Offset(0, i) = fld.Name
        i = i + 1
    Next fld

    ' OUTPUT DATA ROWS
    Worksheets("Results").Range("A2").CopyFromRecordset rst

    rst.Close
    conn.Close

End Sub

Answer 2

假设您的数据库1名为Sheets（＆＃34; Db1＆＃34;），其余的遵循相同的逻辑假设您的示例中的列为A，B和C.

Sub mergeDB
    Dim i as integer
    Dim lastlineDB3 as integer
    Dim strToMatch as string
    Dim FoundCell as range

    lastlineDB3 = Sheets("Db3").Range("A")(Sheets("Db3").Rows.Count).End(xlUp).Row

    for i = 2 to lastlineDB3
        strToMatch = Sheets("Db3").Range("A")(i).Value
        Set Foundcell= Sheets("Db1").Range("A:A").Find(strToMatch, Lookat:=xlWhole)
        If not Foundcell IS nothing then  
             'Now you have found a match for the SSN
             'What you have is the cell with the matching SSN (foundcell)
             'Write your own code here to decide what to do with that information
             'For example to grab the CORTISOL in column C (2 columns to the right)
             ' someString = FoundCell.Offset(0,2).Value
             'You can take all the values you have, I don't know how many you have so I'll let you write that part
             'Send those values over to the Db3 sheet where you want.
             'Hint: The row you want to send them at is row "i"
        End if
    next   

    'Once you matched all the SSNs do the same with the IDs

End sub

附加两个没有公共标识符的数据库

2 个答案: