Question

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

如果上面的所有数据都相同，那么它就是一个简单的删除副本。但是如果有些数据与我需要保留的旧数据相同。我还需要保留重复数据中最多小时的数据。（c栏）

geez ..听起来很疯狂，但我会记录一个宏（图片中有什么）

{{ $user }}

这里的问题是剂量保持最高时数，并且范围不动态

我制作了一个代码 - 只是代码在几小时内保持最大数量。我很近!!我错过了什么？

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

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

Answer 1

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

{{1}}

Answer 2

最佳方法：
你最好的方法是使用dictionary，如果元素重复，则删除它。如果您需要稍后修改参数，以及代码执行本身，这种方法可以节省您很多时间。字典本身旨在管理这样的数据结构。
代码方法：
这可以为您提供适合您需求的适合您的需求。

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

进一步评论： 这样的数据结构起初很难处理，给出其他有用的数据管理变量的读取，例如数组，上面链接中的集合。

Answer 3

好吧，我想我明白了。我首先删除所有相同的diplicates（第1，第2，第3）然后生病删除剩下的将是最低的数字

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

删除条件重复

3 个答案: