Один из способов сделать это - создать макрос, который автоматически выполняет все необходимые действия. Недостатком является то, что он, вероятно, будет неоптимальным с точки зрения производительности, поскольку требуемые операции плохо соответствуют доступной функциональности в 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) и копировать их тоже в таблицу результатов. Он остановится при обнаружении первого ряда с пустым #defect в Sheet1.
Тем не менее, код немного медленный, делает копирование данных немного неловко. Это должно, однако, позволить довольно легкую модификацию для различных размеров диапазонов данных, и с некоторой настройкой это может оказаться достаточно эффективным для этой задачи.