时间戳

首页 > 解决方案 > 删除整个工作表中的重复行

excel - 删除整个工作表中的重复行

问题描述

所以下面是我电子表格的复制部分。它应该连接然后断开下一行。但是我在这里有一些重复项，您可以看到前 4 行中有一对连接和断开连接。我基本上是想知道我可以通过所有单元格并检测一对连接或断开连接的最简单方法，然后删除底部连接和顶部断开连接，因为它们链接在一起。

5997998 D16 connect 2021-06-21 17:31:04.141+00
5997993 D16 connect 2021-06-21 17:30:43.708+00
5997996 D16 disconnect  2021-06-21 17:30:20.106+00
5997979 D16 disconnect  2021-06-21 17:28:08.268+00
5997906 D16 connect 2021-06-21 17:19:03.802+00
5997902 D16 connect 2021-06-21 17:18:43.226+00
5997905 D16 disconnect  2021-06-21 17:18:19.939+00
5997883 D16 disconnect  2021-06-21 17:16:09.056+00
5997812 D16 connect 2021-06-21 17:07:05.033+00
5997807 D16 connect 2021-06-21 17:06:43.875+00
5997808 D16 disconnect  2021-06-21 17:06:20.145+00
5997793 D16 disconnect  2021-06-21 17:04:08.07+00
5997685 D16 connect 2021-06-21 16:54:46.16+00
5997677 D16 disconnect  2021-06-21 16:52:07.01+00
5997604 D16 connect 2021-06-21 16:43:04.436+00

我认为使用宏是可能的，但我不确定我刚刚开始使用宏。不确定这是否可能只是想听听任何人的建议。

标签： excelvba

解决方案

使用扭曲删除重复项

  • 如果列( Col( C)) 中连续两个单元格内容相等，则如果它们包含一个字符串( CritLower( connect))，则删除下一行，如果它们包含另一个字符串( CritUpper( disconnect))，则删除上一行.
Option Explicit

Sub RemoveConnDupes()
    
    ' Define constants.
    Const wsName As String = "Sheet1"
    Const fRow As Long = 2
    Const Col As String = "C"
    Const CritLower As String = "connect"
    Const CritUpper As String = "disconnect"
    
    ' Create references to the workbook and the worksheet.
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
    
    ' Calculate last non-empty (not hidden) row ('lRow').
    Dim lRow As Long: lRow = ws.Cells(ws.Rows.Count, Col).End(xlUp).Row
    ' Validate last row.
    If lRow < fRow Then Exit Sub ' No data (possibly hidden rows).
    
    Dim drg As Range ' Delete Range
    Dim dCell As Range ' Delete Cell
    Dim r As Long ' Row Counter
    
    For r = fRow To lRow - 1
        
        ' Compare the values in two consecutive cells
        ' (the current and the next).
        If ws.Cells(r, Col).Value = ws.Cells(r + 1, Col).Value Then
            
            ' Attempt (there could be a 'third' value) to create a reference
            ' to the cell ('dCell') whose row will be deleted.
            Set dCell = Nothing
            Select Case ws.Cells(r, Col).Value
            Case CritLower
                Set dCell = ws.Cells(r + 1, Col)
            Case CritUpper
                Set dCell = ws.Cells(r, Col)
            'Case Else
                'Set dCell = Nothing ' Redundant because it's already nothing.
            End Select
            
            ' Check if a reference to the cell has been created...
            If Not dCell Is Nothing Then
                ' ... If so, combine the cell into the Delete Range ('drg').
                If drg Is Nothing Then
                    Set drg = dCell
                Else
                    Set drg = Union(drg, dCell)
                End If
            End If
        
        End If
    
    Next r
            
    ' Check if any cells were combined...
    If Not drg Is Nothing Then
        ' ... If so, delete the Delete Range's entire rows.
        drg.EntireRow.Delete
    End If
        
End Sub

推荐阅读