Перекрестное сравнение данных между двумя рабочими книгами

Шаги, необходимые для этого вручную, довольно длинные и утомительные.

Предполагая, что данные в Рабочей книге 1 находятся в Sheet1следующем, выполните следующие действия:

1. Скопируйте данные (включая заголовки) из Рабочей книги 2
2. Вставить в ячейку A1пустого листа в Workbook 1 (скажем Sheet2)
3. Введите эту формулу в G1→=MATCH(B1,Sheet1!B:B,0)
4. Скопируйте или вставьте формулу вниз соответствующим образом. Я предпочитаю эту последовательность нажатий клавиш:
   • Left
   • Ctrl+Down
   • Right
   • Ctrl+ Shift+Up
   • Ctrl+D
5. Включить фильтрацию по столбцу ( Ctrl+ Shift+ L)
6. Фильтр #N/Aтолько. (Если их нет, игнорируйте этот шаг и следующий.)
7. Удалить все #N/Aстроки
8. Удалить столбцы C, D, F,G
9. Выделить данные
10. Скопируйте данные ( исключая заголовки) из Sheet1Рабочей книги 1 (текущей рабочей книги)
11. Щелкните правой кнопкой мыши в ячейке A2с Sheet2и выберитеInsert Copied Cells
12. Убедитесь, что Shift cells downвыбран, нажмитеOK
13. Выберите все данные и удалите дубликаты с помощью Data→ Data Tools→ Remove Duplicates. (Убедитесь, что отмечен только столбец ID.)
14. Сортировать по столбцу ID

Лучшее решение, конечно, состоит в том, чтобы автоматизировать эти шаги. Это то, что делает следующий код VBA.

Скопируйте и вставьте этот код в стандартный модуль в Рабочей книге 1:

'============================================================================================ ' Module : a standard module in Workbook 1 ' Version : 0.1.1 ' Part : 1 of 1 ' References : N/A ' Source : https://superuser.com/a/1331855/763880 '============================================================================================ Option Explicit  Public Sub CrossCompareSheets()  Const s_CompareToWorkbook As String = "Workbook 2.xlsx" Const s_CompareToSheet As String = "Sheet1" Const s_CompareToTopLeft As String = "A1" Const s_CompareToExtraCols As String = "C,D,F" Const s_SourceSheet As String = "Sheet1" Const s_SourceTopLeft As String = "A1" Const n_SourceMatchColumn As Long = 2 Const s_ResultSheet As String = "Sheet2" Const s_ResultTopLeft As String = "A1" Const n_ResultMatchColumn As Long = 2 Const n_ResultUniqueColumn As Long = 1 Const n_ResultSortColumn As Long = 1  Dim wkstCompareTo As Worksheet: Set wkstCompareTo = Workbooks(s_CompareToWorkbook).Worksheets(s_CompareToSheet) Dim rngCompareTo As Range: Set rngCompareTo = wkstCompareTo.Range(s_CompareToTopLeft).CurrentRegion Dim wkstSource As Worksheet: Set wkstSource = ActiveWorkbook.Worksheets(s_SourceSheet) Dim rngSource As Range: Set rngSource = wkstSource.Range(s_SourceTopLeft).CurrentRegion Dim wkstResult As Worksheet: Set wkstResult = ActiveWorkbook.Worksheets(s_ResultSheet) Dim rngResult As Range Dim celResultTopLeft As Range: Set celResultTopLeft = wkstResult.Range(s_ResultTopLeft)  wkstResult.UsedRange.Clear rngCompareTo.Copy Destination:=wkstResult.Range(s_ResultTopLeft) Set rngResult = celResultTopLeft.CurrentRegion With rngResult.Resize(ColumnSize:=1).Offset(ColumnOffset:=rngResult.Columns.Count) .FormulaR1C1 = Replace(Replace(Replace( _ "=MATCH(RC,!C,0)" _, "", n_ResultMatchColumn), "", s_SourceSheet), "", n_SourceMatchColumn) .Copy .PasteSpecial xlPasteValues End With Set rngResult = celResultTopLeft.CurrentRegion rngResult.AutoFilter Field:=rngResult.Columns.Count, Criteria1:="#N/A" rngResult.Offset(RowOffset:=1).SpecialCells(xlCellTypeVisible).EntireRow.Delete rngResult.AutoFilter Dim colsToBeDeleted As Range Set colsToBeDeleted = rngResult.Resize(ColumnSize:=1).Offset(ColumnOffset:=rngResult.Columns.Count - 1).EntireColumn Dim varColumn As Variant For Each varColumn In Split(s_CompareToExtraCols, ",") Set colsToBeDeleted = Union(colsToBeDeleted, wkstResult.Range(varColumn & ":" & varColumn)) Next varColumn colsToBeDeleted.Delete Set rngResult = celResultTopLeft.CurrentRegion rngSource.Offset(RowOffset:=1).Copy Destination:=celResultTopLeft.Offset(RowOffset:=rngResult.Rows.Count) Set rngResult = celResultTopLeft.CurrentRegion rngResult.RemoveDuplicates Columns:=n_ResultUniqueColumn, Header:=xlYes Set rngResult = celResultTopLeft.CurrentRegion With wkstResult.Sort .SortFields.Clear .SortFields.Add Key:=rngResult.Columns(n_ResultSortColumn) .SetRange rngResult .Header = xlYes .Apply End With  End Sub 

Заметки:

Вы можете изменить константы в верхней части, чтобы обслуживать различные столбцы и имена файлов, и код будет автоматически корректироваться.

РЕДАКТИРОВАТЬ перечитал вопрос, и обновил с моим пониманием проблемы ...

Второе редактирование, где я запутался между листами 1 и 2

Чтобы найти данные, которые нужно перейти на новый лист, потому что он существует только на листе 1 ...

=match(a1, sheet2!a:a,0). 

Фильтр для #na.

Чтобы обновить данные на листе 1, добавьте столбец справа от данных, примерно так;

=Iferror(Index(sheet2!d:d,match(a1, sheet2!a:a,0)),D1) 

Скопируйте это в запасной столбец на листе 1, затем скопируйте и вставьте как значения исходного столбца D1.

Еще один пионт; если идентификаторы не совпадают между листами (их нельзя использовать для сопоставления), создайте объединенное имя и код «вспомогательный столбец» или что-либо еще, что можно использовать для правильного сравнения двух листов.

(Если идентификаторы не могут быть использованы для сопоставления, я бы также начал задавать много вопросов о данных, но это выходит за рамки вопроса)

Я хотел бы предложить самый простой способ сравнить и создать уникальный список.

Следуй этим шагам:

• Скопируйте данные из обеих рабочих книг на чистый лист.
• Выберите Все данные.
• На вкладке «Главная» нажмите «Сортировать и отфильтровать».
• Сортировать данные в порядке возрастания по идентификатору.
• Снова выберите все данные.
• Перейдите на вкладку «Данные» и нажмите «Удалить дубликат».
• Выберите столбец ID, чтобы найти и удалить дубликаты.

Вы найдете ваши данные, как показано ниже:

ID Name Code futa-123456 Max 0a futa-123457 Max 0a futa-123458 Max 0a futb-ms8793 John SX futb-xy5543 Sam Sx futg-890153 May gH futg-890154 May GH 

NB

• Показанный выше метод подходит для небольшой базы данных.
• Вы можете записать весь процесс как макрос, чтобы работать быстрее.