Переместить выбранную строку в верх или низ таблицы Excel (исключая один столбец) с помощью VBA

Question

Я хочу иметь два кода VBA: первый перемещает выбранную строку ячейки в столбце (A, C, D, E и F) в верх, а другой перемещает ячейки строки в нижнюю часть таблицы excel.

Например, если я выберу ячейку в C3 и запусту макрос, ячейки (A3, C3, D3, E3 и F3) в строке переместятся в нижнюю часть таблицы.

У меня есть следующий код, который перемещает всю строку вниз:

Public Sub MoveToBottom()

    If Selection.Row <> 1 Then

        'move the whole row
        Selection.EntireRow.Cut
        Range("B1").End(xlDown).Offset(1, 0).EntireRow.Insert

    End If

End Sub

Мои данные выглядят как

Спасибо взаранее

Answer 1

Это довольно быстро и грязно, но должно помочь вам.

Сначала проверяется, что выбранная строка: имеет значения, не является заголовком и уже не является верхней / нижней строкой (в зависимости отфункции).

Затем вставляется строка (только для верхней части), копируется текущая строка туда, где она принадлежит, и удаляется «старая» строка.

Option Explicit

Sub MoveToTop()

    Dim rowCurrent As Long
    rowCurrent = Selection.row

    If WorksheetFunction.CountA(rows(rowCurrent)) >= 5 _
    And rowCurrent <> 1 And rowCurrent <> 2 Then
        Range("A2, C2:F2").Insert Shift:=xlDown

        Range("A" & rowCurrent).copy Destination:=Range("A2")
        Range("C" & rowCurrent & ":F" & rowCurrent).copy Destination:=Range("C2:F2")

        Range("A" & rowCurrent & ", " & "C" & rowCurrent & ":F" & rowCurrent).Delete
    End If

End Sub


Sub MoveToBottom()

    Dim rowCurrent As Long
    rowCurrent = Selection.row

    Dim rowLast As Long
    rowLast = Range("A" & rows.count).End(xlUp).row

    If WorksheetFunction.CountA(rows(rowCurrent)) >= 5 _
    And rowCurrent <> 1 And rowCurrent <> rowLast Then
        Range("A" & rowCurrent).copy Destination:=Range("A" & rowLast + 1)
        Range("C" & rowCurrent & ":F" & rowCurrent).copy Destination:=Range("C" & rowLast + 1 & ":F" & rowLast + 1)

        Range("A" & rowCurrent & ", " & "C" & rowCurrent & ":F" & rowCurrent).Delete
    End If

End Sub