Удалить строку, если 2 условия соблюдены - изменение во времени и то же значение в другой колонке

Question

Я пытаюсь кодировать цикл в Excel VBA, чтобы сделать следующее:

У меня есть столбец, который долгое дата + время , У меня есть другой столбец с текстовой строкой.

Я хочу, чтобы удалить всю строку, если изменение во времени (строка - строка выше) меньше, чем 0:00:05 И значение строки такой же (строка против ряда выше)

I бегу в проблемы с условием 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 

OK, код выше отстой. Я собираюсь исследовать другой подход. Я хочу сравнить столбец F - с текущей ячейкой с под ним. Если они совпадают, тогда вызывается следующее предложение - если текущая ячейка в D равна < 0:00:05 секунд, отличная от той, которая находится под ней, если это так, то удалите (или сохраните информацию для удаления вне цикла).

Если две ячейки в F не совпадают, перейдите к следующей ячейке.

Это имеет смысл? Позвольте мне разработать код и разместить его здесь.

Answer 1

Ваше время должно быть представлено в виде числа, поскольку даты в Excel рассчитываются как количество дней с указанной даты (например, сегодня - 41458 дней с 1 января 1900 года). Таким образом, разделить день на 24, чтобы получить один час, а затем на 12, чтобы получить 5 минут, например:

EDITED

Я переписан код следующие комментарии ниже изменения других факторов, а также время сравнение.

Код, приведенный ниже, является примером того, как вы можете сделать этот макрос автоматически удаляемым новым добавленным строкам. Код должен быть добавлен к листу, на котором вы вносите изменения (а не в модуль или книгу). Если вы не хотите использовать автоматический подход, вы можете либо добавить опцию, чтобы сначала проверить ее у пользователя, либо просто изменить суб и передать объект диапазона, представляющий ячейку только что добавленной строки (сообщите мне, если Вам нужна помощь с этим):

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 

Я настроил некоторые тестовые данные и выше, кажется, хорошо работать на выборочных данных, которые я настроил, дайте мне знать, если у вас есть какие-либо вопросы.

Answer 2

Я вижу различные проблемы, в том числе некоторые показатели, которые не кажутся правильными. Здесь у вас есть улучшенный вариант (цикл собирается в настоящее время вперед, потому что, кажется, более ясно):

 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 

Answer 3

ОК, так что после того, как немного больше копания, я нашел это и изменить его на работу.

Спасибо за помощь Варокарбас и Крис!

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