Excel VBA 删除范围内的重复项

Question

我正在努力更新一些保存主数据的 sheet。

用户可以用新项目更新寄存器 ("TK_Register") 或修改 ("EditEX") sheet 上的现有项目。 EditEx sheet 上的数据存储在 C32:P56 并保存在 TK_Register Sheet 的下一个空行（A 到 N 列）

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

关于运行此代码，

excel 从 EditEx 获取所有数据 sheet C32:P56
将此数据粘贴到 TK_Register Sheet
根据第 "N" 列自动筛选 "NO"（即不需要保留此行）
删除已过滤的行（这些行尚未使用并包含默认数据）
取消过滤数据

这是我遇到问题的地方。将所有数据添加到 TK_Register sheet 包括新项目以及已更新的先前项目。由于我们需要定期添加、更新和更改，当我们需要再次编辑时，我们只想看到最近的行项目出现在 EditEx sheet.

然后用户可以对任何召回的行进行更改and/or添加一个新行。

我的以下代码仅在最后一行引用编号（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 的示例代码，考虑到该列具有 header.

，它从给定范围的第 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

Excel VBA 删除范围内的重复项

Excel VBA Remove duplicates in a range

excel

vba

duplicates

insert-update