Выберите 2 строки данных для вырезания, как только будет найдена ячейка, содержащая «1»

Question

Хорошо, так что я очень простой пользователь. Я использую функцию «Если», чтобы найти провалы в данных, когда провал обнаружен, столбец E показывает «1», все остальные - «0».Но мне нужна вся эта строка с "1" и следующей строкой, даже если она имеет "0" или "1".

В настоящее время у меня есть это: Если ActiveCell.Value = "1" Тогда

Selection.EntireRow.Cut
Sheets("Sheet2").Select
lMaxRows = Cells(Rows.Count, "A").End(xlUp).Row
Range("A" & lMaxRows + 1).Select
ActiveSheet.Paste
Sheets("Sheet1").Select

Остальное

Так что мне нужно сказать ему выбрать строку, содержащую «1» (что он уже делает), а также следующую строку .... остальноеследует вырезать и добавить данные в другой лист.

Answer 1

Отличный пост об альтернативах и более надежных методах, чем «.Select».После прочтения вы можете настроить свой код. Как избежать использования Select в Excel VBA

Чтобы ответить на ваш вопрос, замените

Selection.EntireRow.Cut

на

Range(Selection.EntireRow, Selection.Offset(1, 0).EntireRow).Cut

Это должно дать вамхорошее начало, вам нужно добавить некоторый код, чтобы не вырезать все 5 строк выше, если некоторые из них пустые, потому что они уже вырезаны, или вы можете удалить пустые строки на листе 2, как только этот код будет выполнен.

Sub GetDipsData()
Dim i As Long
Dim c As Long
Dim LastConsecutiveDip As Long
Dim vLastRow As Long

Sheets("Sheet1").Activate
vLastRow = Cells(Rows.Count, "E").End(xlUp).Row

Application.ScreenUpdating = False

For i = 2 To vLastRow
    If Cells(i, "E") = 1 Then
        s2LastRow = Sheets("Sheet2").Cells(Rows.Count, "E").End(xlUp).Row
        For c = i + 1 To vLastRow
            If Cells(c, "E") = 1 Then
                LastConsecutiveDip = c
            Else
                Exit For
            End If
        Next
        If c <> i + 2 Then
            'copy 5 above and 5 below
            If i < 6 Then
                Range(Rows(2), Rows(c).Offset(5, 0).EntireRow).Cut Sheets("Sheet2").Range("A" & s2LastRow)
            ElseIf c + 5 > vLastRow Then
                Range(Rows(i).Offset(-5, 0), Rows(vLastRow).EntireRow).Cut Sheets("Sheet2").Range("A" & s2LastRow)
            Else
                Range(Rows(i).Offset(-5, 0), Rows(c).Offset(5, 0).EntireRow).Cut Sheets("Sheet2").Range("A" & s2LastRow)
            End If
            i = c + 5
        Else
            'just copy 2 rows
            If i + 1 > vLastRow Then
                Rows(i).Cut Sheets("Sheet2").Range("A" & s2LastRow)
            Else
                Range(Rows(i), Rows(i).Offset(1, 0).EntireRow).Cut Sheets("Sheet2").Range("A" & s2LastRow)
                i = i + 2
            End If
        End If
    End If
Next

Application.ScreenUpdating = True

End Sub