VBA - 将唯一值复制到不同的工作表中

时间:2017-11-29 22:59:45

标签: excel vba unique

希望你能帮到我!

所以我有2个工作表,1& 2. Sheet1已经存在数据,Sheet2用于将原始数据转储到。这是每天更新的,数据转储包括前几天的数据以及新数据。新数据可以包括与可能在本月早些时候发生的交互相关的行,而不仅仅是前一天。所以数据不是“日期顺序”。

有9列数据,第I列中有唯一标识符。

我需要发生的是在运行宏时,它在Sheet1和Sheet2中的第一列中查找,并且仅复制和粘贴Sheet1中不存在Sheet 2中的唯一标识符的行。并从Sheet1中的最后一个空行开始粘贴它们。

我目前拥有的是 - 这是我在网上找到的全部内容:

Sub CopyData()

Application.ScreenUpdating = False

Dim LastRow As Long
LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Dim rng As Range
Dim foundVal As Range
For Each rng In Sheets("Sheet2").Range("A1:I" & LastRow)
    Set foundVal = Sheets("Sheet1").Range("I:I").Find(rng, LookIn:=xlValues, LookAt:=xlWhole)
    If foundVal Is Nothing Then
        rng.EntireRow.Copy Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
    End If
Next rng
Application.ScreenUpdating = True 
End Sub

但它只是不起作用 - 它不仅不能识别第一列中的值是否已经存在,它是仅复制和粘贴Sheet2中的前两行,而是每次复制它们8次!

提前道歉,我是一个真正的VBA新手,并且无法解决它出错的地方。我将不胜感激任何帮助!

1 个答案:

答案 0 :(得分:0)

这将做你想要的:

Sub testy()
    Dim wks As Worksheet, base As Worksheet
    Dim n As Long, i As Long, m As Long
    Dim rng As Range

    Set wks = ThisWorkbook.Worksheets(2) 'Change "2" with your input sheet name
    Set base = ThisWorkbook.Worksheets(1) 'Change "1" with your output sheet name

    n = base.Cells(base.Rows.Count, "A").End(xlUp).Row
    m = wks.Cells(wks.Rows.Count, "A").End(xlUp).Row

    For i = 2 To m
        On Error Resume Next
        If IsError(WorksheetFunction.Match(wks.Cells(i, 9), base.Range("I:I"), 0)) Then
            Set rng = wks.Cells(i, 1).Resize(1, 9) 'Change 9 with your input range column count
            n = n + 1
            base.Cells(n, 1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
        End If
    Next i

End Sub