将2个工作表与excel中的宏进行比较

Question

我试图比较来自2个不同工作表的库存（主工作表是＆＃39; Stock09042016＆＃39;）并在新工作表上生成新结果。宏应该是比较主工作表中的数量（F2）到第二个工作表。如果结果不同，则应将这些结果与所有其他列一起复制到新工作表中。如果结果/库存相同，则不应添加到新工作表中（这是我丢失的地方）。

下面的代码也只有一行，它不会复制整个列表。

工作表示例：

宏的结果：

Sub RunMe()
Dim lRow, lrow2 As Long
Dim fValue As Range

Sheets("STOCK09042016").Select
lRow = Range("A1").End(xlDown).Row
lrow2 = Sheets("STOCK26082016").Range("C1").End(xlDown).Row

For Each cell In Range("A2:A" & lRow)
    With Sheets("STOCK26082016").Range("C2:C" & lrow2)
      Set fValue = .Find(cell.Value, LookIn:=xlValues)
      If fValue Is Nothing Then
        cell.EntireRow.Copy Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
      End If
    End With
 Next cell

End Sub

Answer 1

这应该可以胜任。我推测如果数量不同，你想要更换行。

Sub RunMe()
Dim rCell As Range
Dim rSource As Range
Dim rTarget As Range

With ThisWorkbook.Worksheets("STOCK26082016")
    Set rSource = .Range("F2", .Cells(Rows.Count, 6).End(xlUp))
End With

For Each rCell In rSource
    With ThisWorkbook.Sheets(3)

    'Try to find item
    Set rTarget = .Range("B2", .Cells(Rows.Count, 2).End(xlUp)).Find(rCell.Offset(0, -4))

    'Check if entry for this item exist, if not copy entire row to the next empty row
    If rTarget Is Nothing Then
        rCell.EntireRow.Copy Destination:=.Range("A2", .Cells(Rows.Count, 2).End(xlUp)).Offset(1, 0)

    'If it exist, check if the quantity matches. If not, replace the row
    ElseIf Not rTarget.Offset(0, 4).Value = rCell.Value Then
        rCell.EntireRow.Copy Destination:=rTarget.EntireRow
    End If
    End With
 Next rCell

End Sub