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”的方法更可靠的文章。阅读后，您可以调整代码。 How to avoid using Select in 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

找到包含“ 1”的单元格后，选择2行数据进行剪切

1 个答案: