找到活动单元格值后，如何选择上方5行和下方20行

Question

我在其他问题上得到了帮助，但这是一个新问题，当一个单元格的数据值为4时，我需要选择高于5行，低于20行并将数据剪切/复制到另一张纸上。我对其他所有内容进行了排序，只是在数据点的上方和下方进行了剪切。

Answer 1

复制行

Sub RowsCopy()

    Const cSource As Variant = "Sheet1" ' Source Worksheet Name/Index
    Const cTarget As Variant = "Sheet2" ' Target Worksheet Name/Index
    Const cRange As String = "A7"       ' Source Cell Range Address
    Const cCrit As Long = 4             ' Criteria
    Const cRowsA As Long = 5            ' Source Rows Above
    Const cRowsB As Long = 20           ' Source Rows Below

    Dim ws As Worksheet   ' Target Worksheet
    Dim FER As Long       ' Target First Empty Row

    ' In Source Cell Range
    With ThisWorkbook.Worksheets(cSource).Range(cRange)
        ' Create a reference to Target Worksheet.
        Set ws = .Parent.Parent.Worksheets(cTarget)
        ' Calculate Target First Empty Row using column 1 (A).
        FER = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1
        ' Check if value in Source Cell Range meets (is equal to) Criteria.
        If .Value = cCrit Then
            ' Calculate Target Range Above.
            ' Calculate Source Range Above.
            ' Copy values of Source Range Above to Target Range Above.
            ws.Rows(FER).Resize(cRowsA).Value _
                    = .Worksheet.Rows(.Row - cRowsA).Resize(cRowsA).Value
            ' Calculate new Target First Empty Row by adding Source Rows Above.
            FER = FER + cRowsA
            ' Calculate Target Range Below.
            ' Calculate Source Range Below.
            ' Copy values of Source Range Below to Target Range Below.
            ws.Rows(FER).Resize(cRowsB).Value _
                    = .Worksheet.Rows(.Row + 1).Resize(cRowsB).Value
        End If
    End With

End Sub

Sheet1

Sheet2

复制和删除行

Sub RowsCopyDelete()

    Const cSource As Variant = "Sheet1" ' Source Worksheet Name/Index
    Const cTarget As Variant = "Sheet2" ' Target Worksheet Name/Index
    Const cRange As String = "A7"       ' Source Cell Range Address
    Const cCrit As Long = 4             ' Criteria
    Const cRowsA As Long = 5            ' Source Rows Above
    Const cRowsB As Long = 20           ' Source Rows Below

    Dim ws As Worksheet   ' Target Worksheet
    Dim rng As Range      ' Delete Range
    Dim FER As Long       ' Target First Empty Row

    ' In Source Cell Range
    With ThisWorkbook.Worksheets(cSource).Range(cRange)
        ' Create a reference to Target Worksheet.
        Set ws = .Parent.Parent.Worksheets(cTarget)
        ' Calculate Target First Empty Row using column 1 (A).
        FER = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1
        ' Check if value in Source Cell Range meets (is equal to) Criteria.
        If .Value = cCrit Then
            ' Calculate Target Range Above.
            ' Calculate Source Range Above.
            ' Create a reference to Target Range Above (Delete Range).
            Set rng = .Worksheet.Rows(.Row - cRowsA).Resize(cRowsA)
            ' Copy values of Source Range Above to Target Range.
            ws.Rows(FER).Resize(cRowsA).Value = rng.Value
            ' Calculate new Target First Empty Row by adding Source Rows Above.
            FER = FER + cRowsA
            ' Calculate Target Range Below.
            ' Calculate Source Range Below.
            ' Add Target Range Below to Delete Range.
            Set rng = Union(rng, .Worksheet.Rows(.Row + 1).Resize(cRowsB))
            ' Copy values of Source Range Below to Target Range Below.
            ws.Rows(FER).Resize(cRowsB).Value _
                    = .Worksheet.Rows(.Row + 1).Resize(cRowsB).Value
            ' Delete Source Rows
            rng.Rows.Delete ' .Hidden = True, .ClearContents, .Clear
        End If
    End With

End Sub

Answer 2

小型演示：

Option Explicit
Const NEGOFFSET = 5
Const POSOFFSET = 20
Sub test()
    Dim r As Range

    Set r = Range("a6") 'Assuming A6 is the target cell
    r.Select 'Just to show the selected range this far
    Set r = r.Offset(-NEGOFFSET, 0).Resize(NEGOFFSET + 1, 1)
    r.Select 'Just to show the selected range this far
    Set r = r.Resize(POSOFFSET + NEGOFFSET + r.Row, 1)
    r.Select 'Just to show the selected range
    '*
    '* Here r holds the wanted range. Handle it
    '*
End Sub