定期删除重复重复的单元格

Question

在下面的工作表中删除重复的单元格有问题。Col E是时间，而col F是我想组织的时间戳的分钟数。我想要做的是在一小时内删除包含重复分钟的所有行，这样我就可以每5分钟获得我的电流和电源的读数。问题是，有时你得到5，有时6读马上(因为读数是每9，10，或11秒)。另一个问题是，我不能简单地删除所有重复的细胞一天，因为模式重复它是自我每小时，因此我只有一个小时的读数，如果我只是选择所有的细胞。

我在下面的代码中尝试的是，通过双击第一个"E“单元格，在一小时内删除所有具有双分钟值的行。它的工作原理是在第一个小时(0:00-0:55)，但对于以后的数字(小时)，它开始删除额外的行。下一个逻辑步骤，当然是删除所有双值一天。

整个事情不需要是用户友好或互动，我只是想过滤掉5分钟的阅读，如果没有其他，粘贴到一个新的工作表，以进一步分析。

下面是工作表的印刷机，包含数据

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim clickedRow As Long
Dim clickedValue As Long
Dim currentValue As Long
Dim counter As Long

clickedRow = ActiveCell.Row
clickedValue = ActiveCell.Value

For i = clickedRow To (clickedRow + 100)
    currentValue = Range("E" & i).Value
    If (clickedValue = currentValue) Then
        counter = counter + 1
    Else
        Exit For
    End If
Next i

ActiveSheet.Range("A" & clickedRow, "Y" & counter).RemoveDuplicates Columns:=6, Header:=xlNo

End Sub

我尝试过的另一件事，因为它隐藏了所有重复的细胞，却没有遗漏一个，但没有被证明是有效的：

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim clickedRow As Long
Dim clickedValue As Long
Dim currentValue As Long
Dim zadnja As Long
Dim trenutna As Long

clickedRow = ActiveCell.Row
clickedValue = ActiveCell.Value

For i = clickedRow To (clickedRow + 100)

    currentValue = Range("E" & i).Value

    If (currentValue = clickedValue) Then

        zadnja = 5
        trenutna = Range("F" & i).Value

        If (trenutna = zadnja) Then
            Range("E" & i).EntireRow.Hidden = True
        Else
        End If

        zadnja = trenutna

    Else
        Exit For
    End If

Next i

End Sub

Answer 1

当您使用Range.RemoveDuplicates法时，您需要同时考虑时间和分钟。目前，您只是基于分钟(例如，列(6))的复制标准。

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    On Error GoTo bm_Safe_Exit
    If Not Intersect(Target, Union(Columns(5), Columns(6))) Is Nothing Then
        Cancel = True
        Dim xlOriginalCalculation As Long, fr As Long, er As Long, tr As Long
        Application.EnableEvents = False
        xlOriginalCalculation = Application.Calculation
        Application.Calculation = xlCalculationManual

        tr = Target.Row
        fr = Application.Match(Cells(tr, 5).Value, Columns(5), 0)
        If Target.Column = 6 Then
            fr = fr + Application.Match(Cells(tr, 6).Value, Cells(fr, 6).Resize(1440, 1), 0) - 1
            er = fr + Application.CountIfs(Columns(5), Cells(tr, 5).Value, Columns(6), Cells(tr, 6).Value) - 1
        Else
            er = fr + Application.CountIfs(Columns(5), Cells(tr, 5).Value) - 1
        End If

        If fr <> er Then
            With Range("A" & fr & ":Y" & er)
                .RemoveDuplicates Columns:=Array(5, 6), Header:=xlNo
            End With
            With Range("A:Y")
                .Cells.Sort key1:=.Columns(5), order1:=xlAscending, _
                            key2:=.Columns(6), order2:=xlAscending, _
                            Orientation:=xlTopToBottom, Header:=xlYes
            End With
        End If
    End If

bm_Safe_Exit:
    Application.EnableEvents = True
    Application.Calculation = xlOriginalCalculation

End Sub

这样就消除了基于小时和分钟的重复，这样0小时的55分钟就不会与1小时的55分钟混淆。

如果双击MINS列(F列)，则根据分钟对数据进行还原。如果双击HRS列，那么该小时的所有数据都将被删除。

不需要带有工作表代码表的ActiveSheet。