Question

我有一个excel工作簿，需要从一个工作表中获取行，并根据列中的值复制（追加）到另一个工作表。我可以使用下面的代码完成此操作，但显然每次运行此代码时，它都会重复添加相同的行。

即不断添加Sheet1，sheet2是sheet1中所有行的增量日志，第13列中的标记为“是”。两个工作表上的相同列，第1列是唯一ID。

我是否可以添加到此代码中以确保仅复制sheet1中尚未出现在sheet2中的行。

我将下面的代码拼凑在一起，回答了此处发布的其他问题，但似乎无法避免如何避免在sheet2中重复行。我根本没有VBA的先进性。提前感谢您的帮助。

 Sub GasImportToPending()
    Dim x As Long
    Dim iCol As Integer
    Dim MaxRowList As Long
    Dim S As String


    Set wsSource = Worksheets("sheet1")
    Set wsTarget = Worksheets("sheet2")

    iCol = 1
    MaxRowList = wsSource.Cells(Rows.Count, iCol).End(xlUp).Row

    For x = MaxRowList To 1 Step -1
        S = wsSource.Cells(x, 13)
        If S = "Yes" Or S = "yes" Then



            AfterLastTarget = wsTarget.Cells(Rows.Count, 1).End(xlUp).Row + 1

            wsSource.Rows(x).Copy
            wsTarget.Rows(AfterLastTarget).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            End If
    Next

   Application.ScreenUpdating = True

End Sub

Answer 1

尝试以下方法。它使用A列中的唯一标识符，并查看它是否存在于Sheet2的A列中。如果是，它不会复制该行，否则就会复制。

Sub GasImportToPending()
    Dim x As Long
    Dim iCol As Integer
    Dim MaxRowList As Long
    Dim S As String
    Dim fVal As String
    Dim fRange As Range


    Set wssource = Worksheets("sheet1")
    Set wstarget = Worksheets("sheet2")

    iCol = 1
    MaxRowList = wssource.Cells(Rows.Count, iCol).End(xlUp).Row

    For x = MaxRowList To 1 Step -1
        S = wssource.Cells(x, 13)
        If S = "Yes" Or S = "yes" Then

            fVal = wssource.Cells(x, 1).Value

            Set fRange = wstarget.Columns("A:A").Find(What:=fVal, LookIn:=xlFormulas, LookAt _
                :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                False, SearchFormat:=False)

            If fRange Is Nothing Then

                AfterLastTarget = wstarget.Cells(Rows.Count, 1).End(xlUp).Row + 1

                wssource.Rows(x).Copy
                wstarget.Rows(AfterLastTarget).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            End If

        End If
    Next

   Application.ScreenUpdating = True

End Sub

Excel 2010，vba复制行到另一个工作表排除以前根据ID编号复制

1 个答案: