Vba 根据条件删除重复项

我有一个每周更新的数据表。当我添加新数据时，我需要删除重复的数据。但有条件、有规则删除什么和不删除什么。 在我解释的图片中。 基本上，我需要手动查看新数据（黄色）是否具有相同的数字、名称、日期和值

如果上面的所有数据都相同，那么这是一个简单的删除重复。但是，如果有一些数据与旧数据不同，我需要保留它们。我还需要保留重复数据中时间最多的数据

天啊，听起来很疯狂，但我设法录制了一个宏（图片中的内容）

这里的问题是没有保持最高小时数，而且范围不是动态的

我做了一个代码——只是代码没有在几个小时内保持最大的数字。 我好近！！我错过了什么

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-deletetethedoops（）
暗淡的RowNdx与长
对于RowNdx=范围（“A1:G1”）。结束（xlDown）。行到2步骤-1
如果单元格（RowNdx，“A”）.Value=单元格（RowNdx-1，“A”）.Value，则
如果单元格（RowNdx，“F”）.Value=单元格（RowNdx-1，“F”）.Value，则
If Cells（RowNdx，“C”）.Value我觉得您编写的代码非常接近。我只是做一些修改。我认为你最好有两个循环，这样你就可以经常比较第一个循环和第二个循环

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

Sub-deletetethedoops（）
暗淡的RowNdx与长
暗淡的RowNdx2与长
如长
FR=范围（“A1:G1”）。结束（xlDown）。行“冻结此行”
对于RowNdx=FR到2步骤-1
对于RowNdx2=FR到2步骤-1
“据我所知，当A、E和F
'相等，当C最小时，所以。。。
如果RowNdx RowNdx2和_
单元格（RowNdx，“A”）。值=单元格（RowNdx2，“A”）。值和_
单元格（RowNdx，“F”）。值=单元格（RowNdx2，“F”）。值和_
单元格（RowNdx，“E”）。值=单元格（RowNdx2，“E”）。值和_
单元格（RowNdx，“C”）。值>=单元格（RowNdx2，“C”）。然后值
行（RowNdx2）。删除
如果结束
下一行x2
下一个RowNdx
端接头
我觉得您编写的代码非常接近。我只是做一些修改。我认为你最好有两个循环，这样你就可以经常比较第一个循环和第二个循环

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

Sub-deletetethedoops（）
暗淡的RowNdx与长
暗淡的RowNdx2与长
如长
FR=范围（“A1:G1”）。结束（xlDown）。行“冻结此行”
对于RowNdx=FR到2步骤-1
对于RowNdx2=FR到2步骤-1
“据我所知，当A、E和F
'相等，当C最小时，所以。。。
如果RowNdx RowNdx2和_
单元格（RowNdx，“A”）。值=单元格（RowNdx2，“A”）。值和_
单元格（RowNdx，“F”）。值=单元格（RowNdx2，“F”）。值和_
单元格（RowNdx，“E”）。值=单元格（RowNdx2，“E”）。值和_
单元格（RowNdx，“C”）。值>=单元格（RowNdx2，“C”）。然后值
行（RowNdx2）。删除
如果结束
下一行x2
下一个RowNdx
端接头
最佳方法：

最好的方法是使用a，如果元素重复，则将其删除。如果以后需要修改参数以及代码执行本身，这种方法可能会节省大量时间。字典本身就是为了管理这样的数据结构而设计的。

代码方法：

这可能会给你一个很好的空间来满足你的需要，适合你的需要

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


进一步评论：

像这样的数据结构一开始很难处理，请阅读其他有用的数据管理变量，如上面链接中的数组、集合
 最佳方法：

最好的方法是使用a，如果元素重复，则将其删除。如果以后需要修改参数以及代码执行本身，这种方法可能会节省大量时间。字典本身就是为了管理这样的数据结构而设计的。

代码方法：

这可能会给你一个很好的空间来满足你的需要，适合你的需要

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


进一步评论：

像这样的数据结构一开始很难处理，请阅读其他有用的数据管理变量，如上面链接中的数组、集合
 好的，我想我明白了。
我将首先删除所有相同的二硅酸盐（第一、第二、第三）
然后我会删除剩下的将是最低的数字

谢谢你@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

好的，我想我明白了。
我将首先删除所有相同的二硅酸盐（第一、第二、第三）
然后我会删除剩下的将是最低的数字

谢谢你@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

很好！！！！但有一件事。对于最大数字，它适用于大多数情况，但也有一些区域不适用于我的编辑，
FR=Range（“A1:G1”）。结束（xlDown）。行“冻结此行”
？我想我知道发生了什么。我对我的代码做了一个小小的编辑，应该可以做到，但是如果不行，请告诉我。这很好！！！！但有一件事。对于最大数字，它适用于大多数情况，但也有一些区域不适用于我的编辑，
FR=Range（“A1:G1”）。结束（xlDown）。行“冻结此行”
？我想我知道发生了什么。我对我的代码做了一个小小的编辑，应该可以做到这一点，但是如果不行，请告诉我。