macros删除基于一列的重复项，然后将“较旧”的副本移动到另一个表

我有一个数据列A到H的电子表格。我需要删除基于列C中的数据重复。足够简单。

棘手的部分是，我在E列有一个date。我需要“旧”重复被移动到另一个工作表，而不是删除。 我有一个macros将复制到另一个工作表，但它是什么停留/随机select。

如果我需要详细说明，请告诉我！

请求编辑：这不是说这个macros是错误的，这是我不知道如何使它移动旧的副本根据E列date。

Sub DupMove() Dim t As Single Dim d As Object, x&, xcol As String Dim lc&, lr&, k(), e As Range xcol = "C" lc = Cells.Find("*", after:=[a1], searchdirection:=xlPrevious).Column lr = Cells.Find("*", after:=[a1], searchdirection:=xlPrevious).Row ReDim k(1 To lr, 1 To 1) Set d = CreateObject("scripting.dictionary") For Each e In Cells(1, xcol).Resize(lr) If Not d.exists(e.Value) Then d(e.Value) = 1 k(e.Row, 1) = 1 End If Next e Cells(1, lc + 1).Resize(lr) = k Range("A1", Cells(lr, lc + 1)).Sort Cells(1, lc + 1), 1 x = Cells(1, lc + 1).End(4).Row Cells(x + 1, 1).Resize(lr - x, lc).Copy Sheets("Duplicates").Range("A1") Cells(x + 1, 1).Resize(lr - x, lc).Clear Cells(1, lc + 1).Resize(x).Clear End Sub 

Answer 1

尝试以下。 首先，我根本不是一个VBA大师，很多事情可能是错的。 我保留了大部分代码，但是在Dictionary（ d ）中，我不仅添加了值，而且还添加了一个包含行号和列E中的值的数组。这样，当循环到达一个单元格已经在字典中，而不是跳过它，你可以testing两个ColumnE值，并决定保留哪一个。

 Sub DupMove() Dim t As Single Dim d As Object, x&, xcol As String Dim lc&, lr&, k(), e As Range xcol = "C" lc = Cells.Find("*", after:=[a1], searchdirection:=xlPrevious).Column lr = Cells.Find("*", after:=[a1], searchdirection:=xlPrevious).Row ReDim k(1 To lr, 1 To 1) Set d = CreateObject("scripting.dictionary") For Each e In Cells(1, xcol).Resize(lr) If Not d.exists(e.Value) Then 'If not in dictionary, add it d.Add e.Value, Array(Cells(e.Row, 5), e.Row) 'Add the value, and an Array with column E (5) data and number of row k(e.Row, 1) = 1 Else 'If already in dictionary, test the new column E value with that saved in the array If d(e.Value)(0).Value < Cells(e.Row, 5).Value Then k(d(e.Value)(1), 1) = "" k(e.Row, 1) = 1 d(e.Value)(0) = Cells(e.Row, 5) d(e.Value)(1) = e.Row End If End If Next e Cells(1, lc + 1).Resize(lr) = k Range("A1", Cells(lr, lc + 1)).Sort Cells(1, lc + 1), 1 x = Cells(1, lc + 1).End(4).Row Cells(x + 1, 1).Resize(lr - x, lc).Copy Sheets("Duplicates").Range("A1") Cells(x + 1, 1).Resize(lr - x, lc).Clear Cells(1, lc + 1).Resize(x).Clear End Sub