☰

交叉比较两个工作簿之间的数据

tag-icon • tag-icon microsoft-excel worksheet-function comparison highlighting
交叉比较两个工作簿之间的数据

我正在尝试交叉比较两个不同工作簿中的两个数据。然后，我需要找出两者之间缺失的数据，并制作一个单独的新更新列表。但是，只有当第一个列表中有记录时，我才需要更新数据。如果没有，则无需更新该数据。

例如

Workbook 1
ID            Name      Code
...
futa-123456   Max       0a
futa-123458   Max       0a   
futb-ms8793   John      SX
futg-809153   May       gH
...

Workbook 2
ID            Name      Contact Address Code Flag
...
futa-123456   Max       ...       ...    0a   Y
futa-123457   Max       ...       ...    0a   Y
futb-XY5543   Sam       ...       ...    SX   N
futg-809153   May       ...       ...    gH   Y
futg-809154   May       ...       ...    gH   Y
... 

Final Result
Separate new sheet (doesn't natter which workbook)
ID            Name      Code
...
futa-123456   Max       0a
futa-123457   Max       0a* 
futa-123458   Max       0a   
futb-ms8793   John      SX
futg-809153   May       gH
futg-809154   May       gH*
...

因此，对于 Max，Excel 将显示工作簿两侧的差异，因为两侧存在差异，并且这些差异存在于工作簿 1 中。对于 May，只有工作簿 2 将显示差异，因为只有工作簿 2 存在差异（但仍会显示，因为 May 存在于工作簿 1 中）。Sam 不会突出显示，因为工作簿 1 没有 Sam。

基本上，我会以工作簿 1 作为源进行交叉比较。如果工作簿 1 中没有记录，但工作簿 2 中有记录，则不会突出显示。

有没有办法做到这一点？

答案1

手动执行此操作所需的步骤非常漫长且繁琐。

假设工作簿 1 中的数据按照Sheet1以下步骤操作：

  1. 从工作簿 2 复制数据（包括标题）
  2. 粘贴到A1工作簿 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{a},{Sheet}!C{b},0)" _
      , "{a}", n_ResultMatchColumn), "{Sheet}", s_SourceSheet), "{b}", 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

笔记：

您可以更改顶部的常量以适应不同的列和文件名，并且代码将自动调整。

答案2

我想建议最简单的方法来比较和创建唯一的列表。

按着这些次序：

  • 将两个工作簿中的数据复制到一张空白表中。
  • 选择全部数据。
  • 在“主页”选项卡上单击“排序和筛选”。
  • 按ID升序对数据进行排序。
  • 再次选择整个数据。
  • 转到数据选项卡并单击删除重复项。
  • 选择 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

注意：

  • 上述方法适用于小型数据库。
  • 您可以将整个过程记录为宏以加快工作速度。

答案3

编辑重读问题，并更新我对问题的理解......

第二次编辑时我把第一页和第二页弄混了

查找需要放入新工作表中的数据，因为它仅存在于工作表 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 进行匹配，我也会开始询问很多有关数据的问题，但这超出了问题的范围）

相关内容