删除条件重复

我有一个数据图表,我每周更新。 当我添加新的数据,我需要删除重复的数据。 但有条件,规则要删除什么,什么不可以。 在我解释的图片。 基本上我需要手动查看新数据(黄色)是否具有相同的数字,名称,date和值。

如果上面的所有数据是相同的,那么它是一个简单的删除重复。 但是如果有一些数据与旧数据不一样,我需要保留它。 而且我还需要保留重复时间最长的数据(c列)

geez ..它听起来很疯狂,但我pipe理录制一个macros(图片中的whats)

Sub Macro20() ActiveWorkbook.Worksheets("excel").Sort.SortFields.Clear ActiveWorkbook.Worksheets("excel").Sort.SortFields.Add Key:=Range("A2:A80"), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ xlSortTextAsNumbers ActiveWorkbook.Worksheets("excel").Sort.SortFields.Add Key:=Range("G2:G80"), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("excel").Sort .SetRange Range("A1:P80") .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With ActiveSheet.Range("$A$1:$P$80").RemoveDuplicates Columns:=Array(1, 2, 5, 6, 7), _ Header:=xlYes End Sub 

这里的问题是剂量保持最高的小时,而且范围不是dynamic的

我做了一个代码 – 只有代码dosent保持在数小时内最大的数字。 我很近! 我错过了什么?

 Sub DeleteTheDoops() Dim RowNdx As Long For RowNdx = Range("A1:G1").End(xlDown).Row To 2 Step -1 If Cells(RowNdx, "A").Value = Cells(RowNdx - 1, "A").Value Then If Cells(RowNdx, "F").Value = Cells(RowNdx - 1, "F").Value Then If Cells(RowNdx, "C").Value <= Cells(RowNdx - 1, "C").Value Then If Cells(RowNdx, "E").Value <= Cells(RowNdx - 1, "E").Value Then Rows(RowNdx).Delete Else Rows(RowNdx - 1).Delete End If End If End If End IfNext RowNdx End Sub 

我有点失落。 希望我清楚。 谢谢 !!

1

2

3

4

我觉得你写的代码非常接近。 我只是做一些修改。 我认为你最好有两个循环,这样你就可以比较第一个循环和第二个循环。

 Sub DeleteTheDoops() Dim RowNdx As Long Dim RowNdx2 As Long Dim FR as Long FR = Range("A1:G1").End(xlDown).Row 'Freeze this row For RowNdx = FR To 2 Step -1 For RowNdx2 = FR to 2 Step -1 'From what I can tell, you are interested when A, E and F are 'equal and when C is smallest, so ... If RowNdx <> RowNdx2 and _ Cells(RowNdx, "A").Value = Cells(RowNdx2, "A").Value and _ Cells(RowNdx, "F").Value = Cells(RowNdx2, "F").Value and _ Cells(RowNdx, "E").Value = Cells(RowNdx2, "E").Value and _ Cells(RowNdx, "C").Value >= Cells(RowNdx2, "C").Value Then Rows(RowNdx2).Delete End If Next RowNdx2 Next RowNdx End Sub 

最佳方法:
要做到这一点,最好的方法是使用字典 ,如果元素重复,则删除它。 如果您稍后需要修改参数,那么这种方法可以为您节省大量时间,以及代码执行本身。 字典本身被devise成像这样pipe理数据结构。
代码方法:
这可能会给你一个很好的范围,以满足你的需求。

 Sub DuplicatedValues() Dim DictionaryKey As String: DictionaryKey = "" Dim DictionaryForDups As Dictionary Dim CounterCriteriaForDup As Long Dim TotalRows As Long: TotalRows = Sheets("MySheet").Cells(Rows.Count, 1).End(xlUp).Row Dim CounterRows As Long For CounterRows = 2 To TotalRows 'title is 1 'Counter criteria is based on the column within the row For CounterCriteriaForDup = 2 To Sheets("MySheet").UsedRange.Columns.Count 'you may use another approach to get last column if needed Select Case CounterCriteriaForDup Case 1, 3, 5, 6 'Column numbers to get criteria to say it's duplicated A=1, C=3, ... DictionaryKey = DictionaryKey & Trim(Cells(CounterRows, CounterCriteriaForDup).Value) End Select Next CounterCriteriaForDup If Not DictionaryForDups.Exists(DictionaryKey) Then ' 1. If Not DictionaryForDups.Exists(DictionaryKey) Call DictionaryForDups.Add(DictionaryKey, CounterRows - 1) Else ' 1. If Not DictionaryForDups.Exists(DictionaryKey) Rows(CounterRows).Delete CounterRows = CounterRows - 1 End If ' 1. If Not DictionaryForDups.Exists(DictionaryKey) DictionaryKey = vbNullString Next CounterRows End Sub 


进一步评论:
像这样的数据结构起初很难处理,给其他有用的数据pipe理variables,例如上面给出的链接中的数组,集合。

好吧,我想我明白了。 我将首先删除相同的所有重复(第一,第二,第三),然后生病删除剩下的将最低的数字

谢谢@Matt Cremeens

 Sub DeleteTheDoops() Dim RowNdx As LongDim RowNdx2 As LongFor RowNdx = Range("A1:G1").End(xlDown).Row To 3 Step -1 For RowNdx2 = RowNdx - 1 To 2 Step -1 'Begin at one above RowNdx 'when A, E and F are equal so just delete duplicates as normanl If Cells(RowNdx, "A").Value = Cells(RowNdx2, "A").Value And _ Cells(RowNdx, "g").Value = Cells(RowNdx2, "g").Value And _ Cells(RowNdx, "f").Value = Cells(RowNdx2, "f").Value And _ Cells(RowNdx, "h").Value = Cells(RowNdx2, "h").Value And _ Cells(RowNdx, "C").Value = Cells(RowNdx2, "C").Value Then Rows(RowNdx2).Delete End If 'now delete duplicates that have a smaller number in column c If Cells(RowNdx, "A").Value = Cells(RowNdx2, "A").Value And _ Cells(RowNdx, "g").Value = Cells(RowNdx2, "g").Value And _ Cells(RowNdx2, "C").Value >= Cells(RowNdx - 1, "C").Value Then Rows(RowNdx).Delete End If Next RowNdx2 Next RowNdx End Sub