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

i need as the title says to put the data from a column onto the next row. After a lot of research i learned that it can be done using macros and this is where i need your help.

我需要标题说将列中的数据放到下一行。经过大量的研究,我了解到可以使用宏来完成,这是我需要你帮助的地方。

Example of what i need to do:

我需要做的例子:

What i mean is that i have an excel doc with 4 columns

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

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

I want every D column data to go to the next line like this.

我希望每个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.

So i recorded a macro of adding a line on "2" and cuttin-paste the first D on the new 2. The code is this:

所以我录制了一个在“2”上添加一行的宏,并在新的2上剪切粘贴第一个D.代码如下:

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

Result:

The thing is that with a lot of data that needs to be run a lot of times so a loop is really needed here.

问题在于,需要运行很多次数据,因此这里需要一个循环。

Tried using a loop but iam stack here and there is where i need your help

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

Thats how far iam but it doesnt work now as it should.

多大程度上是iam但它现在不能正常工作。

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

Result with lots of data and 2nd modified (not working) code:

包含大量数据和第二个修改(不工作)代码的结果:

thanks in advance.

提前致谢。

1 个解决方案

#1

The best way to do this would be a simple loop through all of the data in D, though the parameters of the loop are complicated by the addition of rows as the loop runs. This is solved by using a do while loop and incrementing the check condition along with the counter

执行此操作的最佳方法是通过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