VBA Excel 2010 – 用于循环删除行如果下一个logging不同于以前的logging基于列值

我有一个行列表，有几列，我想要做的是，删除不符合条件的行基于前面的行的值。 基本上，我有一个列ID与一堆重复自己，另一列与date。

我按这两列升序排列logging

Public Sub sbOrderRecords() Application.Sheets("sheet1").Select ActiveSheet.Sort.SortFields.Clear ActiveSheet.Sort.SortFields.Add Range("A1"), xlSortOnValues, xlAscending ActiveSheet.Sort.SortFields.Add Range("E1"), xlSortOnValues, xlAscending With ActiveSheet.Sort .SetRange Range("A1").CurrentRegion .Header = xlYes .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End Sub 

所以我的目标是删除ID等于上一个logging，但date较旧的logging，只留下一个logging与最新的dateID。

 Public Sub sbDeleteByIMAndDate() Dim currentIM As String Dim MaxDateCurrentIM As Date Dim dateRange As Range Dim imRange As Range With Sheets("sheet1") Set imRange = .Range(.Range("A2"), .Range("A2").End(xlDown)) End With Application.ScreenUpdating = False For IM = 1 To imRange.Rows.Count currentIM = Sheets("Sheet1").Cells(IM, 1).value currentDate = Sheets("Sheet1").Cells(IM, 5).value For J = Range(Range("E2"), Range("E2").End(xlDown)).Rows.Count + 1 To 2 Step -1 If currentIM = Sheets("Sheet1").Cells(J, 1).Value And currentDate > (Sheets("Sheet1").Cells(J, 5).Value) Then Rows(J).EntireRow.Delete End If Next J Next IM Application.ScreenUpdating = True End Sub 

这似乎有效，但速度很慢，只有大约6000条logging。

任何build议将不胜感激

Answer 1

好的，如果需要的话，试试这个，然后调整它。

 Sub DuplicateRows() Dim ws As Worksheet Dim lr As Long, i As Long Dim Rng As Range With Application .Calculation = xlCalculationManual .EnableEvents = False .ScreenUpdating = False End With Set ws = Sheets("Sheet1") lr = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 'Assuming Column A is ID column and column E is Date column ws.Sort.SortFields.Clear ws.Range("A1").CurrentRegion.Sort key1:=Range("A2"), order1:=xlAscending, key2:=Range("E2"), order2:=xlDescending, Header:=xlYes For i = lr To 2 Step -1 'Comparing ID column A If ws.Cells(i, 1) = ws.Cells(i - 1, 1) Then If Rng Is Nothing Then Set Rng = ws.Cells(i, 1) Else Set Rng = Union(Rng, ws.Cells(i, 1)) End If End If Next i If Not Rng Is Nothing Then Rng.EntireRow.Delete End If With Application .Calculation = xlCalculationAutomatic .EnableEvents = True .ScreenUpdating = True End With End Sub 

Answer 2

最快可能会去logging一个macros，并运行删除重复项。 采取这一点，并修改它，以满足您的需求。

注：删除重复将保持它find的第一个条目，并删除其余的比任何我写的更快。 对你有好处，你已经sorting了。

1）将E列sorting改为xlDecsending，这样你的最新版本就会落在你最早的版本之上。

2）select所有单元格，然后单击“数据”选项卡中的“删除重复项”。

3）取消全选，只selectA列。

我认为这应该做你想要的。

效率：你正在击中表单。 所有那些直接检查单元格和修改这些单元格正在杀死你。 研究变体数组。

 Dim arr() as variant arr = sheets("WHATEVER").range("A1:B100").value 

这很简单，快捷。 现在你的数据在RAM不是很好。 像这样分配的variables数组将从第1行第1列的第一个元素开始。 arr(1, 1)是单元格A1， arr(1, 2)是B1。

 For IM = 1 To 1000 currentIM = arr(IM, 1).value currentDate = arr(IM,5).value 

当你想在你的比较中删除一行时，你可以将数据读回到工作表中，当你完成后你可以使用arr(1,1) = "": arr(1,2) = "" 。

 Range("A1:B100") = arr 

你需要sorting后，但这将比你的代码更快，比删除重复的速度慢。