时间戳

首页 > 解决方案 > 当前 VBA 代码根据条件复制，但每次运行时都会复制以前的数据

excel - 当前 VBA 代码根据条件复制，但每次运行时都会复制以前的数据

问题描述

基本上我不熟悉任何类型的编码，我可以输入书面代码并找出我需要更改的内容，但我不擅长编写任何新内容。

我有一个 Excel 电子表格，我们可以跟踪程序的接受和拒绝情况。我需要在第二张纸上跟踪拒绝，以便它们都在一个区域中。

我找到了一个 Excel 的 VBA 代码，它成功地将我想要的信息从一张基于值的工作表复制到第二张工作表。因此，当我选择“拒绝”并运行代码时，它会将所有数据复制到第二张工作表中。需要注意的是，每次运行代码时，它都会提取新数据和以前复制的数据。

我想添加到 VBA 代码以不复制以前复制的数据或找到自动删除重复项的代码。

所以我确实环顾四周，看看是否能找到一些重复数据删除的 VBA 代码，我尝试了一些，但原始代码无法正常运行，并且出现了一些错误。我有一个看起来非常好，但它似乎不能很好地与原始副本代码配合使用。

以下是正在复制被拒绝的当前代码。

Private Sub CommandButton1_Click()

a = Worksheets("ARD2019").Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To a
If Worksheets("ARD2019").Cells(i, 2).Value = "Rejected" Then
    Worksheets("ARD2019").Rows(i).Copy
    Worksheets("Rejected").Activate
    b = Worksheets("Rejected").Cells(Rows.Count, 1).End(xlUp).Row
    Worksheets("Rejected").Cells(b + 1, 1).Select
    ActiveSheet.Paste
    Worksheets("ARD2019").Activate

End If
Next

Application.CutCopyMode = False

我的希望是，我不必告诉使用该程序的人只需手动运行 Excel 的重复数据删除功能，但如果在上面的代码之上编写代码不现实，我认为他们不会抱怨，因为这仍然比他们以前手动处理行的方法要好。

标签： excelvba

解决方案

让我们假设 A 列在两个工作表中都有唯一的键。下面是一个简单的入门方法：

Option Explicit

Private Sub CommandButton1_Click()

    Dim LastRowSour As Long, LastRowDest As Long, Row As Long
    Dim wsSou As Worksheet, wsDes As Worksheet

    'Set worksheets
    With ThisWorkbook
        Set wsSou = .Worksheets("ARD2019")
        Set wsDes = .Worksheets("Rejected")
    End With

    'Find the last row of column A of wsSou
    LastRowSour = wsSou.Cells(wsSou.Rows.Count, "A").End(xlUp).Row

    'Loop start from row 2 to LastRowSour
    For Row = 2 To LastRowSour

        'Find the last row of column A of wsDes
        LastRowDest = wsDes.Cells(wsDes.Rows.Count, "A").End(xlUp).Row

        'Chek if .Cells(Row, 2).Value is reject & wsSou.Cells(Row, 1).Value is not appear in the first column of wsDes
        If wsSou.Cells(Row, 2).Value = "Rejected" And Application.CountIf(wsDes.Range(wsDes.Cells(1, 1), wsDes.Cells(LastRowDest, 1)), wsSou.Cells(Row, 1).Value) = 0 Then

            wsSou.Rows(Row).Copy

            wsDes.Range("A" & LastRowDest + 1).PasteSpecial xlPasteValues

        End If

    Next

    Application.CutCopyMode = False

End Sub

推荐阅读