如何基于两个工作表包含的数据来联接它们

执行此操作的一种方法是创建一个宏，该宏自动执行所有必需的操作。不利的一面是，它在性能方面可能不太理想，因为所需的操作与Excel中的可用功能非常不匹配。

给定工作表Sheet1，Sheet2和Result，以及工作表

#defect type    #quality
4       B       574
1       A       34
2       C       7564
3       A       23
5       A       783
6       B       23

和

#defect action  person  completion
1       foo     John    2.10.2011
3       bar     Eric    14.8.2012
4       zzzz    John    16.2.2013
3       asdf    Jeff    2.8.2012

结果表的列布局为

#defect type    #quality    action  person  completion

以下宏应该执行所要求的操作（修复了原始版本中存在的错误和一些性能问题）：

Sub doFullOuterJoin()
'
' Perform what SQL terminology calls full outer join on two sheets
'
'
    Dim defectRange As Range
    Dim actionRange As Range
    Dim resultSheet As Worksheet

    Set defectRange = Sheets("Sheet1").Range("A2:C999") ' the data range 1
    Set actionRange = Sheets("Sheet2").Range("A2:D999") ' the data range 2
    Set resultSheet = Worksheets("Result")

    defRangeCols = defectRange.Columns.Count
    actRangeCols = actionRange.Columns.Count

    resRow = 2 ' result sheet row number to start filling data at
    lastMatch = 0 ' used to keep track of last matching index to improve performance
    For Each rw In defectRange.Rows
        ' process defects one at a time
        defectId = rw.Cells(1, 1)
        If (defectId = "") Then Exit For
        actIndex = 1
        Do
            ' find all the actions for the current defect
            matchedAction = VLookupRow(defectId, actionRange, lastMatch + 1)
            If (matchedAction = 0) Then
                ' no matching action was found
                If (actIndex = 1) Then
                    ' no actions at all, but copy defect record anyway
                    rw.Copy (resultSheet.Cells(resRow, 1))
                    resRow = resRow + 1
                End If
                lastMatch = 0
                Exit Do ' move on to next defect
            Else
                ' a matching action was found
                rw.Copy (resultSheet.Cells(resRow, 1)) ' copy defect record
                ' copy action data
                actionRange.Cells(matchedAction, 2).Resize(1, actRangeCols - 1).Copy
                resultSheet.Cells(resRow, defRangeCols + 1).Select
                resultSheet.Paste
                actIndex = actIndex + 1
                lastMatch = matchedAction
            End If
            resRow = resRow + 1
        Loop Until actIndex = 999
    Next rw
End Sub


Function VLookupRow(lookup_value, table_array As Range, Optional start_row As Long) As Integer
' Do VLOOKUP-like operation with optionally given start position
' This allows searching sequentially for the rest of matching rows with rather good performance
    Dim nRow As Long

    If (start_row = 0) Then start_row = 1 ' no start row provided, start at first row

    With table_array
        For nRow = start_row To .Rows.Count
            If .Cells(nRow, 1).Value = lookup_value Then
                VLookupRow = nRow
                Exit Function
            End If
        Next nRow
    End With
End Function

基本上，这将逐一遍历缺陷行（Sheet1），将数据复制到结果表（Result），然后找到所有匹配的操作行（Sheet2），并将它们也复制到结果表。当在Sheet1中遇到带有空#defect的第一行时，它将停止。但是，代码有点慢，确实很难复制数据。但是，它应该允许对不同大小的数据范围进行相当轻松的修改，并且通过一些调整，它可能已证明足以完成任务。