Question

我正在尝试在excel vba中编写一个循环来执行以下操作：

我有一个长日期和时间的列。我有另一个包含文本字符串的列。

如果时间的变化（上面的行 - 行）小于0:00:05并且字符串的值相同（上面的行与行），我想删除整行

我遇到IF情况的问题，特别是5秒部分，它不喜欢它......

For Lrow = Lastrow To Firstrow Step -1

  'We check the values in the D column
   With .Cells(Lrow, "D")

      If Not IsError(.Value) Then

        If (Cells(i,"D") - Cells(i-1,"D")) > (0:00:05) AND (Cells.Value(i,"F") = 
        Cells.Value(i-1,"F")
        Then .EntireRow.Delete

      End If

  End With

Next Lrow

好的，上面的代码很糟糕。我将探索一个不同的方法。我想将列F - 与当前单元格与下面的单元格进行比较。如果它们是相同的，则触发下一个子句 - 查看D中的当前单元格是否为＆lt; 0:00:05秒不同于它下面的那个，如果是，则删除（或存储信息以在循环外删除）。

如果F中的两个单元格不相同，则跳到下一个单元格。

那更有意义吗？让我编写代码并在此处发布。

Answer 1

您的时间需要用数字表示，因为Excel中的日期计算为自给定日期以来的天数（例如今天是从1900年1月1日起的41458天）。因此，将一天除以24得到一小时然后除以12得到5分钟，例如：

<强> EDITED

我在下面的评论中重写了代码，改变了其他因素以及时间比较。

以下代码是如何使此宏自动删除添加的新行的示例。应将代码添加到要进行更改的工作表中（而不是模块或工作簿）。如果您不想采用自动方法，那么您可以添加一个选项以首先检查用户，或者只是更改子并传入表示刚刚添加的行上的单元格的范围对象（让我知道是否你需要帮助）：

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim newStr
    Dim newDate
    Dim prevStr
    Dim prevDate
    Dim interval

    newStr = Range("D" & Target.Row).Value
    newDate = Range("F" & Target.Row).Value
    prevStr = Range("D" & Target.Row - 1).Value
    prevDate = Range("F" & Target.Row - 1).Value
    interval = (1 / 24) / 12 ' 5 mins

    If newStr = prevStr And Abs(newDate - prevDate) <= interval Then
        Target.EntireRow.Delete
    End If

End Sub

我已经设置了一些测试数据，上面似乎对我设置的示例数据很有效，如果您有任何问题，请告诉我。

Answer 2

我看到各种各样的问题，包括一些似乎不正确的指数。在这里你有一个改进的版本（循环现在正在进行，因为它似乎更清楚）：

     Dim toDelete(10) As Integer 'Put same size than Lastrow rather than 10
     Dim toDeleteCount As Integer: toDeleteCount = -1
    'FirstRow has to be greater or equal than 2
    Firstrow = 2
    For Lrow = Firstrow To Lastrow Step 1

            'We check the values in the D column
             With Cells(Lrow, "D")
                If Not IsEmpty(.Value) Then

                    If ((CDate(Cells(Lrow, "D")) - CDate(Cells(Lrow - 1, "D")) > CDate("0:00:05")) And (Cells(Lrow, "F") = Cells(Lrow - 1, "F"))) Then
                        Cells(Lrow, "D") = ""
                        Cells(Lrow, "F") = ""
                        'You cannot delete the whole row inside the loop. Just delete the values in the cells you want or store the row number in a variable such that you can delete all the rows outside the loop
                        toDeleteCount = toDeleteCount + 1
                        toDelete(toDeleteCount) = Lrow
                    End If
                End If

            End With
        Next Lrow
        If (toDeleteCount >= 0) Then
           For Each rDelete In toDelete
              Rows(rDelete).Delete
           Next rDelete
        End If

Answer 3

好的，所以经过一番挖掘后，我发现了这一点并将其修改为有效。

感谢您的帮助Varocarbas和Chris！

Sub deleterows()
    Dim myrange, mycell As Range
    Dim myrow()
    Set myrange = Sheets("sheet5").Range("F2", Range("F" & Rows.Count).End(xlUp))
    For Each mycell In myrange
        If mycell.Value = mycell.Offset(-1, 0).Value Then
            If mycell.Offset(0, -2).Value - mycell.Offset(-1, -2).Value <= TimeValue("00:00:05") Then
                q = q + 1
                ReDim Preserve myrow(q)
                myrow(q) = mycell.Row
            End If
        End If
    Next mycell
    For i = q To 1 Step -1
        p = myrow(i)
        myrange(p - 1, 1).EntireRow.Delete
    Next i
End Sub

如果满足2个条件，则删除行 - 在另一列中更改时间和相同值

3 个答案: