Улучшить макрос смещения данных

Question

Пожалуйста, помогите мне с небольшим кодом, который у меня есть.Я надеюсь, что мы можем немного подправить его.У меня есть лист, который имеет столбцы, сгруппированные по 4 и разделенные 2 пустыми столбцами.Данные идут далеко вправо и имеют глубину всего 600 строк.Идея состоит в том, чтобы переместить все разбросанные данные в верх, не оставляя в результате пустых ячеек.Код ниже эффективен и очень быстр.Но будет работать только для первой группы из 4 столбцов из A1.

Мне действительно нужно сделать эту работу, потому что весь другой код, который я пробовалпотому что это занимает слишком много времени.

Я не эксперт по VBA, но я могу пойти только так далеко, как код здесь.Как мы можем изменить его, чтобы он переместил все данные в верхнюю часть для всех столбцов в большем диапазоне?

Sub ShiftDataUp()

Dim y, z

y = Range("a1:p39"): iii = 1
ReDim z(1 To UBound(y, 1), 1 To UBound(y, 2))
For i = 1 To UBound(y)
If Not IsEmpty(y(i, 1)) Then
For ii = 1 To UBound(y, 2)
z(iii, ii) = y(i, ii)
Next
iii = iii + 1
End If
Next
Range("a1:p39").ClearContents
For i = 1 To UBound(y, 1)
For ii = 1 To UBound(y, 2)
Cells(i, ii) = z(i, ii)
Next
Next

End Sub

Answer 1

Попробуйте отсортировать пустые строки.

Dim a As Long, b As Long

With Worksheets("sheet1")
    b = .Cells.Find(What:="*", After:=.Cells(1), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    For a = 1 To b Step 6
        with .Range(.Cells(1, a), .Cells(.Rows.Count, a + 3).End(xlUp))
            .Cells.Sort Key1:=.Columns(1), Order1:=xlAscending, _
                        Key2:=.Columns(2), Order2:=xlAscending, _
                        Orientation:=xlTopToBottom, Header:=xlNo
        End With
    Next a
End With