VBA代码删除有条件的重复项 [英] VBA code to remove duplicates with condition

问题描述

我在工作表1的A到L列中有一些数据

I have some data in sheet 1 columns A to L

我想删除L列中没有数据的F列中的重复ID，或者如果所有重复中都存在数据，则保留任何1.

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.

我想将数据返回到工作表2

I would like to return the data to sheet 2

示例:

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

应该返回

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

推荐答案

在这里，我针对您的问题的处理方法:

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

这篇关于VBA代码删除有条件的重复项的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！