Выбор диапазона из последних 160 строк

Question

У меня есть отфильтрованная таблица, из которой я хочу скопировать последние 160 записей. Мои коды для фильтрации таблицы отлично работают, но следующие коды копируют все 160 строк. Мне нужны последние 160 строк из столбца B в S. Кроме того, могу ли я выбрать последние отфильтрованные 160 строк (ранее отфильтрованных с конкретными критериями), а не последние последние 160 строк? Например: последние 160 строк могут содержать номера строк от 90 до 100 с другими критериями.

Благодарим за помощь. Мои коды являются следующие:

Sub FilterRows() 

Dim LastRow As Long, x As Long 

LastRow = Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row 

x = 160 

Range(LastRow - x + 1 & ":" & LastRow).Copy 

End Sub 

Answer 1

Это скопирует ячейки B: S из последних 160 видимых строк данных.

Sub CopyLastXNumberVisibleRows() 
    Const MaxRows = 160 
    Dim count As Long, lastRow As Long, x As Long 
    Dim SourceRange As Range 

    lastRow = Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row 

    For x = lastRow To 2 Step -1 
     If Not Rows(x).Hidden And Cells(x,"A") = "Some Criteria" Then 
      count = count + 1 

      If SourceRange Is Nothing Then 
       Set SourceRange = Range(Cells(x, "B"), Cells(x, "S")) 
      Else 
       Set SourceRange = Union(SourceRange, Range(Cells(x, "B"), Cells(x, "S"))) 
      End If 

      If count = MaxRows Then Exit For 
     End If 
    Next 

    If Not SourceRange Is Nothing Then 

     SourceRange.Copy Destination:=Sheet1.Range("A2") 

    End If 

End Sub 

Answer 2

Вам придется настроить, где вы хотите, чтобы вывод должен быть скопирован, но попробовать это ниже, используя эту часть кода Cells(1, 1)

Sub test() 
    Sheets("Sheet1").Cells(2, 14).Resize(160, 17).Value = Cells(Cells(Rows.Count, _ 
       2).End(xlUp).Row - 159, 2).Resize(160, 17).Value 
End Sub 

Answer 3

Вы можете думать по-другому. Просто скопируйте все отфильтрованные данные на новый лист, а затем используйте цикл while, чтобы удалить дополнительные данные.

Sub LastRows() 
Dim row As Integer 

Sheets.Add after:=Sheets(Sheets.Count) 
Sheets("Sheet1").Cells(1, 1).CurrentRegion.Copy ActiveSheet.Cells(1, 1) 

row = Range(Cells(1, 1), Cells(1, 1).End(xlDown)).Rows.Count 

If row > 161 Then 'including the title 
    Rows("2:" & (row - 160)).Delete 
End If 
End Sub 

Пожалуйста, измените "Лист1" с названием Технического паспорта в

Answer 4

вы могли бы использовать такую ​​функцию:

Function FilteredRows(nRowsToCopy As Long, rng As Range, firstCol As String, lastCol As String) As Range 
    Dim firstRow As Long: firstRow = 2 

    With rng 
     With .Offset(1, .Parent.UsedRange.Columns.Count).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible).Offset(, .Parent.UsedRange.Columns.Count) 
      .FormulaR1C1 = "=max(R1C:R[-1]C)+1" 
      If WorksheetFunction.Max(.Cells) > nRowsToCopy Then firstRow = .Find(what:=WorksheetFunction.Max(.Cells) - nRowsToCopy + 1, lookat:=xlWhole, LookIn:=xlValues).Row 
      .Clear 
     End With 
     Set FilteredRows = Intersect(.SpecialCells(xlCellTypeVisible), .Parent.Columns(firstCol & ":" & lastCol), .Parent.Rows(firstRow).Resize(.Rows(.Rows.Count).Row - firstRow + 1)) 
    End With 
End Function 

будет эксплуатируемой в основном коде, как следующий образом:

FilteredRows(nRowsToCopy, dataRng, "B", "S").Copy 

, где

• nRowsToCopy является (максимальным) число последних отфильтрованных строк скопировать
• datarng является диапазоном со всеми вашими данными (заголовки включен)
• "B" и "S" являются первыми и последними столбцами, которые будут копироваться