含まれるデータに基づいて2つのワークシートを結合する方法

毎週受け取る2種類のワークシートに参加する方法について、助けてほしい。

シート1には、1週間に観察された欠陥に関する情報（#defect、欠陥のタイプ、＃品質管理）が含まれ、シート2には、これらの欠陥に対して行う必要がある修正アクション（#defect、修正アクション、責任人、完了日）。

これらのデータを統合し、次の列を含む新しいワークシートを作成します：＃defect、defectのタイプ、＃quality control、是正処置、respons。pers、完了日。

VLOOKUP関数を試しましたが、2つの問題に直面しています。

1.）修正アクションテーブル配列のルックアップ値#defect（Defects worksheet）をVLOOKUPしようとしたときに、1つの欠陥に複数の修正アクションがある可能性があるため、一部の結果が見当たりません

2.）Defectsテーブル配列のlookupvalue #defect（Corrective actions worksheet）を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）を1つずつ実行し、データを結果シート（結果）にコピーし、一致するすべてのアクション行（Sheet2）を見つけて、それらも結果シートにコピーします。Sheet1で空の#defectを持つ最初の行に遭遇すると停止します。ただし、コードは少し遅く、データのコピーは少し厄介です。ただし、さまざまなサイズのデータ​​範囲の非常に簡単な変更を許可する必要があり、いくつかのチューニングを行うと、タスクに対して十分に効果的であることが判明する場合があります。