vba - 使用宏在Excel的下一行获取一列

Question

我需要如标题所示将数据从一列放到下一行。经过大量研究后，我了解到可以使用宏来完成此操作，这就是我需要您帮助的地方。

我需要做什么的示例:

我的意思是我有一个包含 4 列的 Excel 文档

   A      B       C        D
1  Data1   Data2  Data3   Data4
2  Data5   Data6  Data7   Data8

我希望每个 D 列数据都像这样转到下一行。

   A      B       C       
1  Data1   Data2  Data3   
2  Data4   // First Data of D column on below line moved on line 2
3  Data5   Data6  Data7 
4  Data8  // Second Data of D column on below line moved on line 4.

所以我录制了一个在“2”上添加一行的宏，并将第一个D剪切粘贴到新的2上。代码是这样的:

Sub Data1()
'
' Data1 Macro
'
' 
'
    ActiveCell.Offset(1, 0).Range("A1:D1").Select
    Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
    ActiveCell.Offset(-1, 3).Range("A1").Select
    Selection.Cut
    ActiveCell.Offset(1, -3).Range("A1").Select
    ActiveSheet.Paste
End Sub

结果:

问题是，大量数据需要运行很多次，因此这里确实需要一个循环。

尝试使用循环，但我在这里堆栈，那里需要你的帮助

这就是我的能力，但它现在无法正常工作。

Dim x As Integer

Sub Data1()
'
' Data1 Macro
'
' 
'
    x = 1


    Do While x <= 20 ' that i will change as how many columns i have.
        ActiveCell.Offset(x, 0).Range("A1:D1").Select
        Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
        ActiveCell.Offset(x - 2, x + 2).Range("A1").Select
        Selection.Cut
        ActiveCell.Offset(x, x - 4).Range("A1").Select
        ActiveSheet.Paste

        x = x + 2 ' if it starts from cell no1 and we have a blank to fill with Data4 or Data8 of D row then we need x+2 i believe and not x+1.
    Loop
End Sub

结果包含大量数据和第二次修改(不起作用)代码:

提前致谢。

Answer 1

执行此操作的最佳方法是对 D 中的所有数据进行简单循环，但循环运行时添加行会导致循环参数变得复杂。这是通过使用 do while 循环并增加检查条件和计数器来解决的

Sub ConvertColDtoRow()
'Note that this code is written specifically for column D, but it can be adjusted as needed by changing the column specified

Dim Count As Long, LastRow As Long
Count = 1
LastRow = ActiveSheet.UsedRange.Rows.Count
Do While Count <= LastRow
    If Not IsEmpty(ActiveSheet.Cells(Count,4)) Then
        Range(Cells(Count,4).Address).Offset(1,0).EntireRow.Insert
        Cells(Count + 1,1).Value = Cells(Count,4).Value
        Cells(Count,4).Value = ""
        Count = Count + 2
        LastRow = LastRow + 1
    Else
        Count = Count + 1
    End If
Loop

End Sub