Вырезать стол на полпути в Excel - PullRequest
0 голосов
/ 23 января 2020

Мой лист содержит автомобили, которые находятся в определенном месте и требуют проверки. Этот список составляется два раза в день и иногда состоит из 10 строк, иногда 14, иногда 12 и c. Теперь я хотел бы вырезать половину строк и поместить их рядом с другими строками (в этом случае вставьте его в ячейку E). Я хотел бы автоматизировать этот процесс, поэтому в VBA должно быть:

  • Количество строк (X)
  • Обрезать строки с X / 2 до X
  • Вставить данные в ячейку E1

Я нашел эту функцию, которая возвращает среднюю ячейку. Тем не менее, я хотел бы собрать это в подпункте.

Function Middle(r As Range) As Variant
  Dim i As Long, j As Long
   If r.Columns.Count > 1 Then
       Middle = [#N/A]
       Exit Function
   End If
  i = r.Row
  j = r.Rows.Count
  Middle = Cells(i + (j - 1) / 2, r.Column).Address
End Function

Sub cutting()
        Range("Middle:C" & Range("A" & Rows.Count).End(xlUp).Row).Select
        Selection.Cut
        Range("E2").Select
        ActiveSheet.Paste
        Range("A1:C1").Select
        Selection.Copy
        Range("E1").Select
        ActiveSheet.Paste
        Cells.Select
        Cells.EntireColumn.AutoFit
        Range("E8").Select
    End Sub

До

После

1 Ответ

0 голосов
/ 23 января 2020

Вам не нужно выбирать данные для работы с ним.
Попробуйте:

Sub Test()

    Dim lLastRow As Long
    Dim lCutRow As Long

    With ThisWorkbook.Worksheets("Sheet1") 'Change Sheet1 to the name of your sheet.
        lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row 'Find last row in column A.
        If lLastRow > 1 Then
            lCutRow = (lLastRow / 2) + 1
            .Range(.Cells(lCutRow, 1), .Cells(lLastRow, 3)).Cut Destination:=.Cells(1, 5) 'Paste to row 1, column 5 (E1).
        End If
    End With

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...