Deleting rows based on condition not working

时间:2017-08-13 14:03:02

标签: excel vba excel-vba datetime

I am new to macro functions and have been trying to remove the rows of 4:00, 12:00, 20:00 of the ETB_DT column of the excel data in order to display the 8 hour table which is the rows of 00:00, 08:00, 16:00, 24:00 hour.

Here is the example of my current data

     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

I have tried the below code but it does not seem to be working.

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

Here is an example of the desired output

          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

Do you have any ideas? Appreciate your help.

3 个答案:

答案 0 :(得分:2)

试试这段代码。

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

答案 1 :(得分:1)

With Sheet.UsedRange 'replace Sheet with your Sheet
For i = .Rows.Count To 2 Step -1
    If InStr(.Cells(i, 1).Value, "8:00:00") = 0 And InStr(.Cells(i, 1).Value, "16:00:00") = 0 And InStr(.Cells(i, 1).Value, "24:00:00") = 0 Then  'change 1 to your column.
        .Cells(i, 1).EntireRow.Delete
    End If
Next i
End With

答案 2 :(得分:1)

前,

enter image description here

代码,

Option Explicit

Sub meh()
    Dim r As Long, tmp As Variant

    With Worksheets("sheet2")
        For r = .Cells(.Rows.Count, "A").End(xlUp).Row To 2 Step -1
            tmp = Split(Split(.Cells(r, "A").Value2, Chr(58))(0), Chr(32))
            Debug.Print Val(tmp(UBound(tmp)))
            Select Case Val(tmp(UBound(tmp)))
                Case 0, 8, 16, 24
                    'do nothing
                Case Else
                    .Rows(r).EntireRow.Delete
            End Select
        Next r
    End With
End Sub

后,

enter image description here

你的星期五似乎在 dddd hh 之间有两个空格