改善Shift数据向上宏

Question

请帮我一些我的代码。我希望我们可以调整一下。我有一张工作表，其列数按4分组，并由2个空白列分隔。数据远远向右，只有600行深。我们的想法是将所有分散的数据移到顶部，从而不再留下空白单元格。下面的代码是有效且非常快的。但只适用于A1的第一组4列。

我真的需要做这项工作，因为我为此尝试过的所有其他代码都采用了太长的方式。

我不是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