Question

我有这个有用的VBA代码，可以比较2张并将重复副本复制到＆＃39;更改＆＃39;片。我需要做相反的事情。我需要将差异复制到更改表。

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

查找从一个工作表到另一个工作表的更改的一种方法是在sheet1的已使用范围的每个单元格中添加具有以下公式的sheet3：

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

然后在整行中添加一列到sheet3。应复制计数大于零的任何行。您可以过滤然后手动复制粘贴或在第三张中的计数列中运行for循环，并根据第3页中的行来复制第二张中的行

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使用范围内的所有单元格，并将公式复制到下一个可用列中。

比较工作表以复制差异

1 个答案: