首页 文章

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

提问于
浏览 次
0

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

即Sheet1不断添加到，sheet2是sheet1中所有行的增量日志，第13列中的标记为Yes . 两个工作表上的相同列，第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
vba excel-vba excel-2010 excel

1 回答

  • 0

    请尝试以下方法 . 它使用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
    回复于

相关问题