макрос Excel с критериями столбцов для копирования двух строк на одном листе на другой

Question

Мне нужен макрос, который ищет строку в столбце; при нахождении этой строки она копирует строку, в которой находится эта строка, а также строку над ней.

Например:

Ищите "мальчик" в столбце 5; если найдено в строке 6, скопируйте строку 6 и строку 5; затем найдите следующего "мальчика" в колонке 5.

Как я могу это сделать?

Answer 1

вот твой макрос

Sub Findining()

    Dim Col As Range
    Dim fs As Worksheet
    Dim s As String
    Dim ws As Worksheet
    Dim r As Range

    Set fs = Sheets(ActiveSheet)
    Set Col = Application.InputBox("Select Column to Look Through", Type:=8)
    If Col.Columns.Count > 1 Then
      Do Until Col.Columns.Count = 1
        MsgBox "You can only select 1 column"
        Set Col = Application.InputBox("Select Column to Compare", Type:=8)
      Loop
    End If

    s = InputBox("Enter string to search for:", "Enter String")
    Set ws = Sheets(fs.Index + 1)
    c = Split(Col.Address, "$")(1)

    For i = 1 To fs.Range(c & Rows.Count).End(xlUp).Row
        Set r = fs.Range(c & i)
        If StrComp(r, s, vbTextCompare) = 0 Then
            fs.Rows(r.Row & ":" & r.Row).Copy
            ws.Activate
            ws.Rows(ws.Range(c & Rows.Count).End(xlUp).Row + 1 & ":" & ws.Range(c & Rows.Count).End(xlUp).Row + 1). _
                PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        End If
        Set r = Nothing
        fs.Activate
    Next i

End Sub