使用宏在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

带有大量数据和第二次修改（不起作用）的结果代码:

提前致谢。

- foutzos

---

“但是现在它不像应该的那样工作。”你能解释得更详细一些吗？输出结果是什么？ - litelite

使用第一个记录的宏，我得到了这个。https://s32.postimg.org/xqofxu1lh/Work1.png 使用第二个宏并在数组中添加更多数据，我得到了这个。 https://s31.postimg.org/c1ffzj4nv/Notwork.png 从这个 https://s32.postimg.org/5d0qlsvkl/sample.png - foutzos

你应该编辑你的问题，将这些图片添加进去，而不是保留在评论中。 - litelite

只使用2个链接，因为我没有声望，但可以。 - foutzos

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

- RGA

---

非常感谢 @RGA。你在这里为我节省了很多时间。 - foutzos

如果您可以将“Count < LastRow”编辑为“Count <= LastRow”，它会使用“=”更改最后一行。 - foutzos

@foutzos 这正是stackoverflow的用途。你花时间按照社区准则正确地提出问题，所以我很乐意花时间来帮助你 :) - RGA