我必须删除重复的旧行

时间:2017-04-17 13:09:21

标签: vba

这是我的表,

ID  Task    Status      Send by
1   Ring    Completed   raja
2   Sing    Completed   rani
3   Ping    Completed   Manthiri
4   Ding    Completed   Sithal
5   Wing    Completed   thief
6   Ring    Completed   raja
7   Sing    Completed   rani
8   Ping    Completed   Manthiri
9   Ding    OnGoing     Sithal
10  Wing    OnGoing     thief

通过使用重复功能,我得到结果为

ID  Task    Status      Send by
1   Ring    Completed   raja
2   Sing    Completed   rani
3   Ping    Completed   Manthiri
4   Ding    Completed   Sithal
5   Wing    Completed   thief

但我需要结果

ID  Task    Status      Send by
1   Ring    Completed   raja
2   Sing    Completed   rani
3   Ping    Completed   Manthiri
9   Ding    OnGoing     Sithal
10  Wing    OnGoing     thief

请帮助。

1 个答案:

答案 0 :(得分:0)

最好的解决方案是使用Excel - VBA。如果您在此宏中遇到任何问题或动态设置范围,请与我们联系。

Sub Maaya()

Dim Colm, lastrow As Integer
Dim Value1, Value2 As String

'Activate the sheet where you have the data
Sheets("Sheet1").Activate

'Remove Duplicates and Sort the data
Range("A1:D11").Select
ActiveSheet.Range("$A$1:$D$11").RemoveDuplicates Columns:=Array(2, 3, 4), _
        Header:=xlYes
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("D2:D8"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A1:D8")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
End With



'pick the last row of the data
Colm = WorksheetFunction.Match("ID", Sheets("Sheet1").Rows(1), 0)
lastrow = ActiveSheet.Cells(Rows.Count, Colm).End(xlUp).Row

'' Delete if there is a match
For i = 2 To lastrow

    Value1 = Range("D" & i).Value
    Value2 = Range("D" & i + 1).Value
' Value3 and Value 4 can also be used if your input changes and set it up to pick up the Task and then take it to the If loop accordingly

    If Value1 = Value2 Then
    Rows(i).Delete
    End If

Next

End Sub