VBA code to remove duplicates with condition

2019-09-11 23:27发布

I have some data in sheet 1 columns A to L

I will like to remove duplicate IDs in column F where there's no data in column L or if data exists in all duplicates, leave any 1.

I would like to return the data to sheet 2

example:

A B C D E ColumnF  G H I J K   ColumnL
            1                 00:20:21     
            1                 00:20:21
            2                 
            2
            2                 00:00:20

Should return

   1                 00:20:21
   2                 00:00:20

2条回答
相关推荐>>
2楼-- · 2019-09-12 00:05

Here, my approach for your problem:

Public Sub removeDuplicate()

    Dim row, innerRow, resultRow, index As Integer

    'Create array for no of data row in Sheet1
    Dim finishedRow(10) As String

    row = 1
    resultRow = 1
    index = 1

    With Sheets("Sheet1")

        'Loop until ID cell is blank
        Do While .Range("F" & row) <> ""

            If UBound(Filter(finishedRow, row)) < 0 Then

                'Add row to finished record
                finishedRow(index) = row
                index = index + 1

                'Store first data in result sheet
                Sheets("Sheet2").Range("A" & resultRow) = .Range("F" & row)
                Sheets("Sheet2").Range("B" & resultRow) = .Range("L" & row)

                innerRow = 1

                'Find duplicate data and compare and if need, modify old data
                Do While .Range("F" & innerRow) <> ""

                    'If this row is not finished in checking
                    If UBound(Filter(finishedRow, innerRow)) < 0 Then

                        'If ID are equal
                        If .Range("F" & row) = .Range("F" & innerRow) Then

                            'If new time is greater than old time
                            If .Range("L" & row) < .Range("L" & innerRow) Then

                                'Update time in result record
                                Sheets("Sheet2").Range("B" & resultRow) = .Range("L" & innerRow)

                            End If

                            'Add row to record array
                            finishedRow(index) = innerRow
                            index = index + 1

                        End If

                    End If

                    'Increase inner row
                    innerRow = innerRow + 1

                Loop

                'Increase result row
                resultRow = resultRow + 1

            End If

            'Increase row
            row = row + 1

        Loop

    End With

End Sub
查看更多
We Are One
3楼-- · 2019-09-12 00:06

Does it have to be VBA? I would do it this way:

Sort your data by columns F an L. In cell M2 enter the following formula:

=IF(AND(L2=L1,F2=F1),"","X")

Then either filter you data where column M equals 'X' or sort by column M, you will then have the non-duplicates which you can copy and paste to your new location.

查看更多
登录 后发表回答