将内容剪切到下一行，保持范围内的其他内容

Question

我想从E1：G1中的单元格中删除存在的单元格，并将其添加到D2，然后将A1：C1中的范围内的单元格复制到下一行，

并执行到下一行，依此类推，直到它们具有从E到G列的内容为止。

我已经尝试在Excel中使用“数据-文本到列”，但是我不能使用它来复制到行...

我想要获得的格式是这种格式，但是我很难找到Vba代码来做到这一点。

Answer 1

您可以尝试：

Option Explicit

Sub test()

    Dim LastRow As Long, LastColumn As Long, i As Long, y As Long
    Dim Avalue As String, BValue As String, Cvalue As String

    With ThisWorkbook.Worksheets("Sheet1")

        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        For i = LastRow To 1 Step -1

            Avalue = .Range("A" & i).Value
            BValue = .Range("B" & i).Value
            Cvalue = .Range("C" & i).Value

            LastColumn = .Cells(i, .Columns.Count).End(xlToLeft).Column

            If LastColumn > 4 Then

                For y = LastColumn To 5 Step -1

                   .Rows(i + 1).EntireRow.Insert

                    .Cells(i + 1, 1).Value = Avalue
                    .Cells(i + 1, 2).Value = BValue
                    .Cells(i + 1, 3).Value = Cvalue
                    .Cells(i, y).Cut .Cells(i + 1, 4)

                Next y

            End If

        Next i

    End With

End Sub

阵列版本

Option Explicit

Sub test()

    Dim LastRow As Long, LastColumn As Long, i As Long, y As Long
    Dim Avalue As String, BValue As String, Cvalue As String
    Dim ABCvalues As Variant

    With ThisWorkbook.Worksheets("Sheet1")

        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        For i = LastRow To 1 Step -1

            ABCvalues = .Range("A" & i & ":C" & i).Value

            LastColumn = .Cells(i, .Columns.Count).End(xlToLeft).Column

            If LastColumn > 4 Then

                For y = LastColumn To 5 Step -1

                    .Rows(i + 1).EntireRow.Insert

                    .Range("A" & i + 1 & ":C" & i + 1).Value = ABCvalues

                    .Cells(i, y).Cut .Cells(i + 1, 4)

                Next y

            End If

        Next i

    End With

End Sub