问连接两个工作表；第一个工作表包含一个范围列表，第二个工作表包含可能在第一个工作表范围内的数据。
EN

Stack Overflow用户

提问于 2015-06-15 14:08:51

回答 1查看 49关注 0票数 0

我正在把两个excel工作表结合起来。在开始之前，我想提到我也有mysql工作台，所以我愿意在sql或vba中处理这个问题(我应该同时学习两者)。我正在处理.bed文件，这些文件是基因组坐标的列表。简而言之，数据是以染色体数(即:chr2 2)为索引的，然后在染色体上有一个数字的开始和停止位置。这些数字位置可以跨越很大的范围(即:100-10,000)，也可以是单个位置(即: 999-1000)。我有一个大范围的坐标列表，在一个单独的文件中，我有一个单一位置的列表。

具有范围的文件示例：

chromosome    start   stop
chr1          4561    6321
chr3          9842   11253

具有单个位置的文件示例：

chromosome   start   stop
chr1          5213   5214
chr3          10254  10255

我希望将这些工作表组合起来，以便如果在我的范围列表中的范围内找到了我的单职位列表中的位置，则这两个位置都将在同一行中列出。列表是1000 s的位置长，所以我也希望这个程序循环每一行。使用上面列出的示例数据，我希望输出如下所示：

期望输出的示例：

chromosome  start   stop  chromosome  start  stop
chr1         4561   6321    chr1      5213   5214
chr3         9842  11253    chr3     10254  10255

有一个很大的可能性，多个单一的位置将在一个范围内，我希望这些被列为单独的行。

我很感激我能得到的任何帮助！提前谢谢你。我渴望学习！

mysql

vba

excel

回答 1

Stack Overflow用户

回答已采纳

发布于 2015-06-15 17:19:07

下面是一个基本大纲，它查询两个表，分别命名为“Range”和“Position”，并在一个名为“结果”的工作表上输出结果。

输入表应该有标题，并从左上角单元格(A1)开始。

Sub SqlJoin()

    Dim oConn As New ADODB.Connection
    Dim oRS As New ADODB.Recordset
    Dim sPath
    Dim sSQL As String, wb As Workbook

    Set wb = ThisWorkbook

    sSQL = " select a.chromosome, a.start, a stop," & _
            " b.chromosome, b.start, b.stop " & _
            " from <ranges_table> a, <positions_table> b" & _
            " where b.start >= a.start and b.stop <= a.stop"


    sSQL = Replace(sSQL, "<ranges_table>", _
           Rangename(wb.Worksheets("Ranges").Range("A1").CurrentRegion))

    sSQL = Replace(sSQL, "<positions_table>", _
           Rangename(wb.Worksheets("Positions").Range("A1").CurrentRegion))

    If wb.Path <> "" Then
      sPath = wb.FullName
    Else
      MsgBox "The workbook must be saved first!"
      Exit Sub
    End If

    oConn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source='" & sPath & "';" & _
                 "Extended Properties='Excel 12.0;HDR=Yes;IMEX=1';"

    oRS.Open sSQL, oConn

    If Not oRS.EOF Then
        wb.Worksheets("Results").Range("A2").CopyFromRecordset oRS
    Else
        MsgBox "No records found"
    End If

    oRS.Close
    oConn.Close

End Sub

Function Rangename(r As Range) As String
    Rangename = "[" & r.Parent.Name & "$" & _
                r.Address(False, False) & "]"
End Function