Excel VBA условное удаление макроса проблема

Question

У меня есть рабочий лист, содержащий некоторые объединенные данные из двух разных источников. Существует один общий/общий столбец - время/дата.

Столбцы B-E содержат данные, если столбцы F-G этого не делают, и наоборот.

Что я хочу сделать, это столбец F, когда я нахожу значение, я хочу перейти в столбец E и работать до тех пор, пока не найду значение. В этот момент я хочу проверить его значение - если оно меньше 4, то я хочу удалить строку, которая первоначально вызвала поиск столбца E.

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

Итак, мой код, над которым я сейчас работаю, выглядит следующим образом: он работает некорректно, и я пытаюсь устранить его, чтобы он работал правильно, но я испытываю трудности. Любая информация/совет/помощь, которую вы могли бы предоставить, были бы весьма признательны.

Set myrange = Sheets("Test Sheet").Range("F2", Range("F" & Rows.Count).End(xlUp)) 
    For Each mycell In myrange 
     rrow = rrow + 1 
      If IsEmpty(mycell.Value) = False Then 
       For j = rrow To 0 Step -1 
        If IsEmpty(mycell.Offset(j, -1)) = False And mycell.Cells(j, -1).Value < 4 Then 
        mycell.Cells(rrow, -1).EntireRow.Delete 
        GoTo line 
        Else 

        End If 
       Next j 
line: 

     Else 





     End If 
    Next mycell 

Answer 1

Попробуйте это:

Sub DeleteRows() 

    Dim ColFRow As Long 
    Dim ColERow As Long 
    Dim ToDelete As Range 

    For ColFRow = ActiveSheet.UsedRange.Rows.Count To 1 Step -1 
     If (Not IsEmpty(Cells(ColFRow, 6).Value)) Then 
      For ColERow = ColFRow To 0 Step -1 
       If (Not IsEmpty(Cells(ColERow, 5).Value)) Then 
       If Cells(ColERow, 5).Value > 4 Then 
        If ToDelete Is Nothing Then 
         Set ToDelete = Cells(ColFRow, 1).EntireRow 
        Else 
         Set ToDelete = Union(ToDelete, Cells(ColFRow, 1).EntireRow) 
        End If 
       End If 
       Exit For 
      End If 
      Next ColERow 
     End If 
    Next ColFRow 


    ToDelete.Delete 


    End Sub