Блог

У меня много сотрудников в списке, показывающем, какие курсы они прошли. Столбец A — это их идентификатор клиента, столбец M — курс, который они закончили.

Как мне удалить строку, если для каждого идентификатора существует дублирующаяся запись курса, поскольку некоторые сотрудники будут использовать одно и то же название курса.

Используйте функцию удаления дубликатов в Excel, просто выделите 2 столбца, из значений которых вы хотите удалить дубликаты. Краткий пример ниже:

Затем выберите в диалоговом окне 2 столбца, которые вы хотите проверить на наличие повторяющихся значений (обязательно снимите флажки со всех столбцов, которые не относятся к делу).

Мой пример вывода:

Удалить дублирующиеся строки, т.е. Скрыть или удалить

• В 1-м подразделе показано, как использовать 2-й, основной подраздел ( removeDuplicateRows ).
• Остальные вспомогательные модули вызываются из основного вспомогательного модуля (также необходимо).
• Только после завершения тестирования переходите от скрытия к удалению.

Код

 Option Explicit

Sub testRemoveDuplicateRows()
    
    Const wsName As String = "Sheet1"
    Const LastRowColumnID As Variant = "A" ' e.g. 1 or "A"
    Const FirstRow As Long = 2
    Dim ColumnIDs As Variant: ColumnIDs = Array(1, "M")
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
    
    ' Hide duplicate rows.
    removeDuplicateRows ws, ColumnIDs, LastRowColumnID, FirstRow, True

    ' Delete duplicate rows.
    'removeDuplicateRows ws, ColumnIDs, LastRowColumnID, FirstRow

End Sub

Sub removeDuplicateRows(Sheet As Worksheet, _
                        ColumnIDs As Variant, _
                        Optional LastRowColumnID As Variant = 1, _
                        Optional FirstRow As Long = 1, _
                        Optional hideOnly As Boolean = False)

    ' Write values of columns to jagged array.
    Dim Cols As Variant
    getColumns Cols, Sheet, ColumnIDs, LastRowColumnID, FirstRow
    
    ' Join values of arrays in jagged array.
    Dim Data As Variant: joinColumns Data, Cols
    
    ' Write duplicate row numbers to array.
    Dim RowOffset As Long: RowOffset = FirstRow - 1 ' 1 = ubound(Data)
    Dim DupeRows As Variant
    collectDuplicateRows DupeRows, Data, RowOffset
    
    ' Hide or delete duplicate rows.
    If hideOnly Then
        hideRows Sheet, DupeRows
    Else
        deleteRows Sheet, DupeRows
    End If
      
End Sub

Sub getColumns(ByRef Data As Variant, _
               Sheet As Worksheet, _
               ColumnIDs As Variant, _
               Optional LastRowColumnID As Variant = 1, _
               Optional FirstRow As Long = 1)
    
    Dim ubc As Long: ubc = UBound(ColumnIDs)
    If ubc = -1 Then Exit Sub
    
    Dim rng As Range: getColumnRange rng, Sheet, LastRowColumnID, FirstRow
    If rng Is Nothing Then Exit Sub
    
    ReDim Data(ubc): getColumnFromColumnRange Data(0), rng
    
    If ubc > 0 Then GoSub getRemainingColumns
     
    Exit Sub

getRemainingColumns:
    Dim j As Long
    For j = 1 To ubc
        getColumnFromColumnRange Data(j), _
          rng.Offset(, Sheet.Columns(ColumnIDs(j)).Column - rng.Column)
    Next j
    Return

End Sub

Sub getColumnRange(ByRef ColumnRange As Range, _
                   Sheet As Worksheet, _
                   Optional ColumnID As Variant = 1, _
                   Optional FirstRow As Long = 1)
    
    Set ColumnRange = Nothing
    
    Dim rng As Range
    Set rng = Sheet.Columns(ColumnID).Find("*", , xlValues, , , xlPrevious)
    
    If rng Is Nothing Then Exit Sub
    If rng.Row < FirstRow Then Exit Sub
    
    Set ColumnRange = Sheet.Range(Sheet.Cells(FirstRow, ColumnID), rng)

End Sub
                    
Sub getColumnFromColumnRange(ByRef Data As Variant, _
                             ColumnRange As Range)
    If ColumnRange Is Nothing Then Exit Sub
    If ColumnRange.Cells.Count > 1 Then
        Data = ColumnRange.Value
    Else
        ReDim Data(1 To 1, 1 To 1): Data(1, 1) = ColumnRange.Value
    End If
End Sub
                             
Sub joinColumns(ByRef Data As Variant, _
                ColumnsArray As Variant, _
                Optional Delimiter As String = "|||")
    
    Data = ColumnsArray(0)
    If UBound(ColumnsArray) = 0 Then Exit Sub
    
    Dim ubr As Long: ubr = UBound(Data)
    Dim j As Long, i As Long
    For j = 1 To UBound(ColumnsArray)
        For i = 1 To ubr
            Data(i, 1) = Data(i, 1) amp; Delimiter amp; ColumnsArray(j)(i, 1)
        Next i
    Next j
    
End Sub
                
Sub collectDuplicateRows(ByRef DupeRows As Variant, _
                         Data As Variant, _
                         Optional RowOffset As Long = 0, _
                         Optional DupeRowsFirstIndex As Long = 0)
    
    Dim ub As Long: ub = UBound(Data)
    If ub < 2 Then Exit Sub
    
    Dim i As Long, k As Long, m As Long: m = DupeRowsFirstIndex - 1
    ReDim DupeRows(DupeRowsFirstIndex To ub   DupeRowsFirstIndex - 2)
    
    For i = 1 To ub - 1
        For k = i   1 To ub
            If Data(k, 1) = Data(i, 1) Then
                m = m   1
                DupeRows(m) = k   RowOffset
                Exit For
            End If
        Next k
    Next i
    
    If m > DupeRowsFirstIndex - 1 Then
        ReDim Preserve DupeRows(DupeRowsFirstIndex To m)
    Else
        DupeRows = Empty
    End If
    
End Sub

Sub deleteRows(Sheet As Worksheet, _
               RowNumbers As Variant)
    
    Dim rng As Range: Set rng = Sheet.Rows(RowNumbers(LBound(RowNumbers)))
    If UBound(RowNumbers) > LBound(RowNumbers) Then GoSub collectRemainingRows
    
    If Not rng Is Nothing Then rng.EntireRow.Delete
    
    Exit Sub
    
collectRemainingRows:
    Dim j As Long
    For j = LBound(RowNumbers)   1 To UBound(RowNumbers)
        Set rng = Union(rng, Sheet.Rows(RowNumbers(j)))
    Next j
    Return
    
End Sub

Sub hideRows(Sheet As Worksheet, _
             RowNumbers As Variant)
    
    Dim rng As Range: Set rng = Sheet.Rows(RowNumbers(LBound(RowNumbers)))
    If UBound(RowNumbers) > LBound(RowNumbers) Then GoSub collectRemainingRows
    
    If Not rng Is Nothing Then rng.EntireRow.Hidden = True
    
    Exit Sub
    
collectRemainingRows:
    Dim j As Long
    For j = LBound(RowNumbers)   1 To UBound(RowNumbers)
        Set rng = Union(rng, Sheet.Rows(RowNumbers(j)))
    Next j
    Return
    
End Sub