VBAmacros来比较和增加价值

我想做一个macros来比较一个表格中的值与另一个表格，并复制唯一的值。

说明：
我每周都会得到一堆ID（工作表A）。 我想看看在过去的几周里，我已经使用了哪些这些ID（该列表位于Worksheet B上），并将Worksheet A中新的所有值复制到Worksheet B.您可以将所需结果看作Worksheet B运行macros后）。

我想出了一些代码，但是因为我是VBA新手，它不起作用，现在我非常绝望。 感谢任何人的帮助。

Sub Mymacro() Dim lastRowC As Long Dim foundTrue As Boolean Dim Data As Worksheet Dim GivenValues As Worksheet Dim IDs As Long Dim fVal As Range Set Data = Sheets("Worksheet B") Set GivenValues = Sheets("Worksheet A") lastRowC = Data.Cells(Rows.Count, 1).End(xlUp).Row IDs = GivenValues.Cells(Rows.Count, 1).End(xlUp).Row 'imagine data in Worksheet B are in the first column For i = 1 To IDs Set fVal = Data.Range("A1:A" & lastRowC).Find(GivenValues.Cells(i, 1).Value, LookIn:=xlValues, LookAt:=xlWhole) If fVal Is Nothing Then GivenValues.Cells(i, 1).Copy Sheets(Data).Select Range("A1").Select Selection.End(xlDown).Select ActiveCell.Offset(1, 0).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Else: End If Next i End Sub 

Answer 1

代码将是这样的。

  Sub Mymacro() Dim lastRowC As Long Dim foundTrue As Boolean Dim Data As Worksheet Dim GivenValues As Worksheet Dim IDs As Long Dim fVal As Range Dim rngDB As Range, vDB, rngT As Range Dim vR(), n As Long Set Data = Sheets("Worksheet B") Set GivenValues = Sheets("Worksheet A") lastRowC = Data.Cells(Rows.Count, 1).End(xlUp).Row IDs = GivenValues.Cells(Rows.Count, 1).End(xlUp).Row Set rngDB = Data.Range("a1", "a" & lastRowC) With GivenValues vDB = .Range("a1", "a" & IDs) End With 'imagine data in Worksheet B are in the first column For i = 1 To IDs Set fVal = rngDB.Find(vDB(i, 1), LookIn:=xlValues, LookAt:=xlWhole) If fVal Is Nothing Then n = n + 1 ReDim Preserve vR(1 To n) vR(n) = vDB(i, 1) End If Next i Set rngT = Data.Range("a" & Rows.Count).End(xlUp)(2) If n > 0 Then rngT.Resize(n) = WorksheetFunction.Transpose(vR) End If End Sub 

如果你想复制，请看下面的代码。

 Sub Mymacro() Dim lastRowC As Long Dim foundTrue As Boolean Dim Data As Worksheet Dim GivenValues As Worksheet Dim IDs As Long Dim fVal As Range Dim rngDB As Range, vDB, rngT As Range Dim vR(), n As Long Dim X As New Collection Set Data = Sheets("Worksheet B") Set GivenValues = Sheets("Worksheet A") lastRowC = Data.Cells(Rows.Count, 1).End(xlUp).Row IDs = GivenValues.Cells(Rows.Count, 1).End(xlUp).Row Set rngDB = Data.Range("a1", "a" & lastRowC) With GivenValues vDB = .Range("a1", "a" & IDs) End With 'imagine data in Worksheet B are in the first column On Error Resume Next For i = 1 To IDs Set fVal = rngDB.Find(vDB(i, 1), LookIn:=xlValues, LookAt:=xlWhole) If fVal Is Nothing Then Err.Clear X.Add vDB(i, 1), CStr(vDB(i, 1)) If Err.Number = 0 Then n = n + 1 ReDim Preserve vR(1 To n) vR(n) = vDB(i, 1) End If End If Next i Set rngT = Data.Range("a" & Rows.Count).End(xlUp)(2) If n > 0 Then rngT.Resize(n) = WorksheetFunction.Transpose(vR) End If End Sub