0

我正在尝试在 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 中的当前单元格是否与其下方的单元格不同 < 0:00:05 秒，如果是，则删除（或存储信息以在循环外删除）。

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

这更有意义？让我编写一个代码并将其发布在这里。

4

3 回答 3

1

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

已编辑

我根据下面的评论重新编写了代码，更改了其他因素以及时间比较。

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

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

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

于 2013-07-03T16:57:25.830 回答
1

我看到了各种问题，包括一些似乎不正确的指标。在这里，您有一个改进的版本（循环现在向前推进，因为它似乎更清晰）：

     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
于 2013-07-03T17:02:11.157 回答
1

好的，所以经过更多的挖掘，我找到了这个并对其进行了修改以使其工作。

感谢您的帮助 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
于 2013-07-05T17:27:41.543 回答