Question

我有以下宏，它非常接近我的需要。我遇到的问题是，如果数据已经在sheet2中，它会插入一个新行和相同的数据，因为我不希望它重复。我尝试过一些东西，但我不能到达那里

{{1}}

所有帮助表示赞赏 SHEET1 SHEET2

Answer 1

在我的下面的代码中，我按照他们的名字（例如＆＃34; A＆＃34;，＆＃34; B＆＃34;）而不是他们的数字来引用列。这不是批评。相反，我更喜欢使用数字，通常在枚举中声明它们。但是，我觉得你可能会发现我的代码在我选择的语法中更具可读性。

Sub CopyUniqueItems()
    ' 09 Aug 2017

    Const RsFirst As Long = 2
    Const RtFirst As Long = 2
    Const Lot As Long = 1
    Const Part As Long = 2
    Const Col As Long = 3

    Dim WsS As Worksheet                    ' S = Source
    Dim WsT As Worksheet                    ' T = Target
    Dim Rng As Range
    Dim Itm As Variant
    Dim Rs As Long, RsLast As Long          ' Row / last row in WsS
    Dim Rt As Variant, RtLast As Long       ' Row / last row in WsT

    Set WsS = Worksheets(1)                 ' { better to call by name
    Set WsT = Worksheets(2)                 ' { like Worksheets("Sheet2")
    RsLast = WsS.Cells(WsS.Rows.Count, "C").End(xlUp).Row

    Application.ScreenUpdating = False
    For Rs = RsFirst To RsLast
        With WsS
            Itm = .Range(.Cells(Rs, "A"), .Cells(Rs, "C")).Value
        End With
        With WsT
            RtLast = .Cells(.Rows.Count, "A").End(xlUp).Row
            With .Columns("A")
                Set Rng = .Range(.Cells(RtFirst), .Cells(RtLast))
            End With
            On Error Resume Next
            Rt = Application.Match(Itm(1, Lot), Rng, 0)
            If IsError(Rt) Then
                ' not found
                Rt = Application.Max(RtLast + 1, RtFirst)
            Else
                ' exists already
                Rt = Rt + RtFirst - 1
                Do
                    If (.Cells(Rt, "G").Value = Itm(1, Part)) And _
                       (.Cells(Rt, "H").Value = Itm(1, Col)) Then
                       Rt = 0
                       Exit Do
                    Else
                        Rt = Rt + 1
                    End If
                Loop While .Cells(Rt, "A").Value = Itm(1, Lot)
                .Rows(Rt).Insert Shift:=xlShiftDown
            End If

            If Rt Then
                .Cells(Rt, "A").Value = Itm(1, Lot)
                .Cells(Rt, "G").Value = Itm(1, Part)
                .Cells(Rt, "H").Value = Itm(1, Col)
            End If
        End With
    Next Rs
    Application.ScreenUpdating = True
End Sub

BTW，Dim rowStartSheet1, rowStartSheet2, lastRowSheet1, lastRowSheet2 As Integer仅将lastRowSheet2声明为整数。所有其他都是未定义的，因此是变体。

如果数据已在工作表中，则不插入VBA代码

1 个答案: