基於條件不工作刪除行

我是新的宏功能，並試圖刪除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

你有什麼想法的例子嗎？感謝你的幫助。

來源

2017-08-13 Faheera

請仔細閱讀[在什麼情況下我想補充「緊急」或其他類似的短語我的問題，爲了獲得更快的答案？]（// meta.stackoverflow.com/q/326569） - 總結是，這不是解決志願者問題的理想方式，而且可能對獲得答案起反作用。請不要將這添加到您的問題。 – halfer

您聲明您希望在保留*'08:00，16:00，24:00'行的同時*'刪除4:00，12:00，20:00'行。什麼，祈禱告訴你打算做的* 00：00：00 *行？ – Jeeped

@Jeeped嗨，我忘了說我還打算保留它 – Faheera

試試看看這個代碼。

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

來源

2017-08-13 14:44:43

嗨，非常感謝你這個作品！ – Faheera

@Faheera：Glads，它適合你。 –

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

來源

2017-08-13 14:11:44

嗨，這給了我一個沒有錯誤的下一個，你知道爲什麼嗎？ – Faheera

@Faheera對不起，我忘了'結束如果'。它現在應該工作 –

@velblúd - 雖然它可能需要OP的確認，但我相信這些是文本看起來像日期時間，而不是真正的日期時間。 Excel沒有數字格式，可以顯示7位小數位;最大值是3位小數（例如毫秒）。 – Jeeped

之前，

代碼，

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

來源

2017-08-13 14:53:51 Jeeped

基於條件不工作刪除行

回答

相關問題