比较工作表以复制差异

Question

我有这个有效的 VBA 代码，可以比较 2 张工作表并将重复项复制到"更改"工作表。我需要做相反的事情。我需要将差异复制到更改表中。

Sub CompareSheets()
Dim Sht1Rng As Range
Dim Sht2Rng As Range
Set Sht1Rng = Worksheets("RXCP Order").Range("A1", Worksheets("RXCP Order").Range("A1000").End(xlUp))
Set Sht2Rng = Worksheets("QS1 Order").Range("A1", Worksheets("QS1 Order").Range("A1000").End(xlUp))
For Each c In Sht1Rng
    Set d = Sht2Rng.Find(c.Value, LookIn:=xlValues)
    If Not d Is Nothing Then
        Worksheets("Changes").Range("A1000").End(xlUp).Offset(1, 0).Value = c.Value
        Worksheets("Changes").Range("A1000").End(xlUp).Offset(0, 1).Value = c.Offset(0, 1).Value
        Set d = Nothing
    End If
Next c
End Sub

Answer 1

查找从一个工作表到另一个工作表的更改的一种方法是在工作表3使用范围的每个单元格中添加工作表1：

=if(Sheet1!A1<>Sheet2!A1,1,0)

然后在工作表 3 中添加一列，在行中添加。应复制计数大于零的任何行。您可以过滤然后手动复制粘贴，或者向下运行 for 循环第三工作表中的计数列，并根据工作表 3 中的行从工作表 2 复制该行

dim aCell as range
with thisworkbook
for each acell in .sheets("Sheet3").Range("Z1:Z1000")
  if acell.value > 0 then
    .sheets("Sheet1").range("A" & acell.row).entirerow.copy _
    .sheets("Sheet4").range("A" & .sheets("Sheet4").usedrange.rows.count + 1)
  end if
next acell
end with

您可以编写一个宏来将上面的公式复制到sheet3使用范围内的所有单元格，并将公式复制到下一个可用列中。