Excel VBA删除范围内的重复项

Question

我正在努力更新包含主数据的多个工作表。

用户可以用新项目更新寄存器（“ TK_Register”）或修改（“ EditEX”）表上的现有项目。 EditEx表上的数据存储在C32：P56中，并保存在TK_Register表的下一个空行（A到N列）

使用不同的代码，我可以根据参考编号（存储在O32：O56单元格中的EditEX表上以及M列的TK_Register表中，调用所有特定的行。

在运行此代码时，

• excel从EditEx表格C32：P56中获取所有数据
• 将此数据粘贴到TK_Register工作表上的下一个空行中
• 基于“ N”列为“ NO”的自动过滤器（即不需要保留此行）
• 删除已过滤的行（这些行尚未使用并包含默认数据）
• 取消过滤数据

这是我遇到的问题。这会将所有数据添加到TK_Register工作表中，包括新项目以及已更新的先前项目。由于我们需要进行定期的添加，更新和更改，因此当我们需要对其进行再次编辑时，我们只希望看到最新的订单项出现在EditEx工作表上。

然后，用户可以对任何被调用的行进行更改和/或添加新的行。

我的下面的代码仅在最后一行参考编号（M列）重复的情况下有效。如果要添加多于1行，则不会找到重复项。我知道我已经走了很长一段路，但是如果找到了任何想法，我如何让它搜索要粘贴的每个参考号（M列）（会有多行），如果没有，则用新数据更新该行，添加到下一个可用行。

    Sub SaveUpdatedRec()

        Dim rng4 As Range
        Set rng4 = Sheets("EditEx").Range("C32:P56")
        Sheets("TK_Register").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(rng4.Rows.Count, rng4.Columns.Count).Cells.Value = rng4.Cells.Value
        Sheets("TK_Register").Range("A1:N1000").AutoFilter field:=14, Criteria1:="NO"
        Application.DisplayAlerts = False
        Sheets("TK_Register").Range("A2:N1000").SpecialCells(xlCellTypeVisible).Delete
        Application.DisplayAlerts = True
        On Error Resume Next
        Sheets("TK_Register").ShowAllData
        On Error GoTo 0


    Sheets("AI_Register").Select
      Range("A1").Select

       Dim lrow1 As Long
       For lrow1 = Worksheets("AI_Register").Cells(Rows.Count, "M").End(xlUp).Row To 2 Step -1
           If Cells(lrow1, "M") = Cells(lrow1, "M").Offset(-1, 0) Then
              Cells(lrow1, "M").Offset(-1, 0).EntireRow.Delete
           End If

        Next lrow1

       ActiveWorkbook.RefreshAll
        Sheets("EditEx").Select
        ActiveWindow.SmallScroll Down:=-120
        Range("B13").Select

    MsgBox ("Record Updates have been Saved")

    End Sub

Answer 1

下面是使用.RemoveDupliates的示例代码，考虑到该列具有标题，该代码从给定范围的列1中删除重复项。

Option Explicit

Sub test()

    Dim LastroW As Long

    With ThisWorkbook.Worksheets("Sheet1")

        LastroW = .Cells(.Rows.Count, "A").End(xlUp).Row

        .Range("A1:A" & LastroW).RemoveDuplicates Columns:=1, Header:=xlYes

    End With

End Sub