根据条件不工作删除行

我是新的macrosfunction，并试图删除excel数据的ETB_DT列的4:00，12:00，20:00的行，以显示作为00:00行的8小时表，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 

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

Answer 1

试试这个代码。

 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 

Answer 2

 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 

Answer 3

之前，

码，

 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 

后，

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