☰

如何根据包含的数据合并两个工作表

tag-icon • tag-icon microsoft-excel vlookup
如何根据包含的数据合并两个工作表

我想要一些帮助，关于如何合并我每周收到的两张不同的工作表。

表 1 包含有关一周内观察到的缺陷的信息（#缺陷、缺陷类型、#质量控制），表 2 包含有关针对这些缺陷需要采取的纠正措施的信息（#缺陷、纠正措施、负责人、完成日期）。

我想整合这些数据并创建一个包含以下列的新工作表：#defect、缺陷类型、#quality control、纠正措施、响应、完成日期。

我尝试使用 VLOOKUP 函数，但遇到两个问题：

1.) 当我尝试在“纠正措施”表数组中对查找值 #defect（缺陷工作表）进行 VLOOKUP 时，我错过了一些结果，因为一个缺陷可以有多个纠正措施

2.) 当我尝试在缺陷表数组中对查找值#defect（纠正措施工作表）进行 VLOOKUP 时，我也错过了一些结果，因为并非每个缺陷都有纠正措施。

我将不胜感激任何帮助！

答案1

执行此操作的一种方法是创建一个宏，它可以自动执行所有必需的操作。缺点是，它的性能可能不是最理想的，因为所需的操作与 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 的行时，它将停止。但是，代码有点慢，复制数据有点笨拙。但是，它应该允许相当容易地修改不同大小的数据范围，并且经过一些调整，它可能足以完成这项任务。

相关内容