Excel 2010，将vba复制到另一张表的行排除了先前根据ID号复制的内容 [英] Excel 2010, vba copy row to another sheet exclude previously copied based on ID number

问题描述

我有一个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

解决方案

请尝试以下操作.它使用列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

I have an excel workbook with a requirement to take rows from one sheet and copy (append) to another sheet based on the value within a column. I can accomplish this using the code below, but obviously each time I run this code, it will append the same rows over again.

i.e Sheet1 is constantly added to, sheet2 is an incremental log of all the rows in sheet1 that have a flag of Yes in column 13. Same columns on both sheets, column 1 is a unique ID.

Is there a way I can add to this code in order to make sure only rows from sheet1 that do not already appear in sheet2 are copied.

I cobbled the code below together from an answer to other questions posted here, but cannot seem to figure uot how to avoid duplicating rows in sheet2. Im not that advanced with VBA at all. Thanks in advance for any help.

 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

解决方案

Try the following. It uses the unique identifier in Column A and sees if it exists in Column A on Sheet2. If it does, it doesn't copy the row, otherwise it does.

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号复制的内容的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！