在Excel中比较2个工作表和一个macros

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

另外下面的代码只做一行，它不会复制整个列表。

工作表示例：

macros的结果：

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