定期删除重复的单元格

我在删除以下工作表中的重复的单元格时遇到问题。 E栏是小时,F栏是时间戳的分钟,我想组织。 我想要做的是在一个小时内删除所有包含重复分钟的行,以便每5分钟读取一次我的电stream和功率。 问题在于,有时你会在一分钟内得到5次,有时甚至是6次读数(因为读数是每9,10或11秒)。 另一个问题是,我不能简单地删除所有重复的细胞一天,因为模式每小时重复它自己,如果我简单地select所有细胞,只留下一小时的读数。

我在下面的代码中试图通过双击第一个出现的第一个“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 

另一件我试过的东西,没有被certificate是有效的,因为它把所有重复的细胞都藏了起来,

 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 

当您使用Range.RemoveDuplicates方法时,您需要考虑小时和分钟。 目前,您只是基于一分钟的重复标准(例如Columns(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 。