根据条件删除行不起作用

法赫拉

我是宏函数的新手，一直试图删除 excel 数据的 ETB_DT 列的 4:00、12:00、20:00 的行，以显示 8 小时表，即 00:00 的行, 08:00, 16:00, 24:00 小时。

这是我当前数据的示例

     ETB_DT_TEST           PREDICTED_RECORDS
Friday   00:00:00.0000000             3
Saturday 00:00:00.0000000             4  
Friday   04:00:00.0000000             105
Saturday 04:00:00.0000000             5
Friday   08:00:00.0000000             10
Saturday 08:00:00.0000000             15
Friday   12:00:00.0000000             30
Saturday 12:00:00.0000000             112
Friday   16:00:00.0000000             56
Saturday 16:00:00.0000000             45
Friday   20:00:00.0000000             10
Saturday 20:00:00.0000000             5
Friday   24:00:00.0000000             34
Saturday 24:00:00.0000000             115

我已经尝试了下面的代码，但它似乎不起作用。

Sub Button2_Click()
Dim pattern As String
pattern = "04:00"
RowCount = ActiveSheet.UsedRange.Rows.Count
Dim i As Integer

For i = 1 To RowCount
    Dim j As Integer
    For j = 1 To 1
        If Cells(i, j) = pattern Then
           Cells(i, j).EntireRow.Delete
        End If
    Next j
Next i
End Sub

这是所需输出的示例

          ETB_DT_TEST              PREDICTED_RECORDS
    Friday   00:00:00.0000000             3
    Saturday 00:00:00.0000000             4  
    Friday   08:00:00.0000000             10
    Saturday 08:00:00.0000000             15
    Friday   16:00:00.0000000             56
    Saturday 16:00:00.0000000             45
    Friday   24:00:00.0000000             34
    Saturday 24:00:00.0000000             115

你有什么想法？感谢您的帮助。

李戴

试试这个代码。

Sub test()
    Dim rngDB As Range, rng As Range
    Dim rngU As Range, vArray
    Dim i As Integer, isYes As Boolean

    Set rngDB = Range("a1", Range("a" & Rows.Count).End(xlUp))
    vArray = Array("04:00:00", "12:00:00", "20:00:00")

    For Each rng In rngDB
        isYes = False
        For i = 0 To UBound(vArray)
            If InStr(rng, vArray(i)) Then
                isYes = True
                Exit For
            End If
        Next i
        If isYes Then
            If rngU Is Nothing Then
                Set rngU = rng
            Else
                Set rngU = Union(rngU, rng)
            End If
        End If
    Next rng
    If rngU Is Nothing Then
    Else
        rngU.EntireRow.Delete
    End If

End Sub

本文收集自互联网，转载请注明来源。

如有侵权，请联系 [email protected] 删除。