删除条件重复
我有一个数据图表,我每周更新。 当我添加新的数据,我需要删除重复的数据。 但有条件,规则要删除什么,什么不可以。 在我解释的图片。 基本上我需要手动查看新数据(黄色)是否具有相同的数字,名称,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
我有点失落。 希望我清楚。 谢谢 !!
我觉得你写的代码非常接近。 我只是做一些修改。 我认为你最好有两个循环,这样你就可以比较第一个循环和第二个循环。
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