给定两张纸的数据，我想在第三张纸上显示差异

Question

我能够比较两张纸，并在第二张纸上用红色和黄色突出显示差异。我希望能够将第二张纸复制到第三张纸上，并在其中进行突出显示，这样我的第一张和第二张原始纸都不会受到影响。

我尝试创建第三张纸并尝试使用.copy进行复制，但是没有用。

Answer 1

假设您对自己的实际代码感到满意，只需添加第三页以显示突出显示的颜色：

Sub checked()
    Dim mycell As Range
    Dim shtSheet1 As Worksheet
    Dim shtSheet2 As Worksheet
    Dim shtSheet3 As Worksheet

    Set shtSheet1 = Worksheets("Sheet1")
    Set shtSheet2 = Worksheets("Sheet2")
    Set shtSheet3 = Worksheets("Sheet3")

    With Worksheets("Sheet2")
        For Each mycell In .UsedRange
            If Not mycell.Value = shtSheet1.Range(mycell.Address).Value Then
                shtSheet3.Cells(1, mycell.Column).Interior.Color = vbYellow
            End If
            If Not mycell.Value = shtSheet1.Cells(mycell.Row, mycell.Column).Value Then
                shtSheet3.Range(mycell.Address).Interior.Color = vbRed
            End If
        Next
    End With
End Sub

Answer 2

突出显示差异

要点

  

  
• 创建第二个工作表的副本。
  
• 重命名新工作表。
  
• 计算使用范围（Not UsedRange）。
  
• 为黄色和红色创建范围的并集。
  
• 将格式应用于范围的并集。
  

代码

Sub HighDiff()

  Const cVntWs1 As Variant = "Sheet1"       ' First Worksheet Name/Index
  Const cVntWs2 As Variant = "Sheet2"       ' Second Worksheet Name/Index
  Const cStrWsDiff As String = "Diff"       ' Diff Worksheet Name

  Dim URng As Range                         ' Used Range (Second Worksheet)
  Dim uCell As Range                        ' Range Control Variable
  Dim URng1 As Range                        ' First Union of Ranges
  Dim URng2 As Range                        ' Second Union of Ranges

  ' Create a copy of Second Worksheet (Diff Worksheet)
  ThisWorkbook.Worksheets(cVntWs2).Copy after:=ThisWorkbook.Worksheets(cVntWs2)

  With ThisWorkbook.Worksheets(ThisWorkbook.Worksheets(cVntWs2).Index + 1)

    ' Rename Diff Worksheet.
    .Name = cStrWsDiff

    ' Calculate the used range (Not UsedRange) in Diff Worksheet.
    If Not .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), -4123, , 1) _
        Is Nothing Then Set URng = .Range(.Cells(.Cells.Find("*", _
        .Cells(.Rows.Count, .Columns.Count)).Row, .Cells.Find("*", _
        .Cells(.Rows.Count, .Columns.Count), , , 2).Column), .Cells(.Cells _
        .Find("*", , , , 1, 2).Row, .Cells.Find("*", , , , 2, 2).Column))

    ' Create unions of ranges.
    For Each uCell In URng
      If uCell.Value <> ThisWorkbook.Worksheets(cVntWs1) _
          .Cells(uCell.Row, uCell.Column).Value Then
        If Not URng1 Is Nothing Then
          Set URng1 = Union(URng1, .Cells(1, uCell.Column))
          Set URng2 = Union(URng2, .Cells(uCell.Row, uCell.Column))
         Else
          Set URng1 = .Cells(1, uCell.Column)
          Set URng2 = .Cells(uCell.Row, uCell.Column)
        End If
      End If
    Next

    ' Apply formatting to unions of ranges.
    URng1.Interior.Color = vbYellow
    URng2.Interior.Color = vbRed

  End With

  ' Release object references.
  Set URng2 = Nothing
  Set URng1 = Nothing
  Set uCell = Nothing
  Set URng = Nothing

End Sub