VBA宏来比较和增加值

Question

我想要做一个宏来比较一张纸上的值与另一张纸上的值并复制唯一的值。

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

，我想出了一些代码，但因为我是新来的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