需要Excel VBA脚本将值从其他列移动到新插入的行

Question

我正在寻找一个Excel VBA脚本，它将值从其他列移动到新插入的行。列A中的值包含列B到E中的引用号。这些值必须与列A中的值保持一致。我需要插入一个新行并将列中的值移动到新行。我已经开始编写一个我认为脚本可以工作的算法。我只需要帮助将其转换为VBA代码。

从C栏开始 如果单元格为空，则跳转到下一行
如果单元格包含值，请复制值
       +插入新行并将副本值粘贴到B列下的新行

中

在：

A2 contains eeee    
B2 contains 111    
C2 contains 2222    
D2 contains 333   

之后：

A2 contains eeee    
B2 contains 111     
B3 contains 2222     
B4 contains 333 

Answer 1

如果您的数据如下所示：

试试这个：

Sub loopColC()
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet1")

    last_row = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row

    For j = last_row To 1 Step -1
        If (Range("C" & j) <> "") Then
            Range("C" & j).Offset(1, 0).EntireRow.Insert Shift:=xlDown
            Range("C" & j).Offset(1, -1).Value = Range("C" & j).Value
            Range("C" & j).Clear
        End If
    Next
End Sub

---

结果如下：

Answer 2

试试这个：它保持原始范围不变

Sub tester()

Dim rngSrc As Range, rw As Range, c As Range
Dim arr(), i As Long, x As Long, bNew As Boolean

    'set the source range
    Set rngSrc = ActiveSheet.Range("A2:Y20")

    'resize the destination array
    ReDim arr(1 To rngSrc.Cells.Count, 1 To 2)
    i = 0

    'loop through the range and fill the array
    For Each rw In rngSrc.Rows
        If rw.Cells(1).Value <> "" Then
            i = i + 1
            arr(i, 1) = rw.Cells(1).Value
            bNew = True
            For x = 2 To rw.Cells.Count
                If rw.Cells(x).Value <> "" Then
                    If Not bNew Then i = i + 1
                    arr(i, 2) = rw.Cells(x).Value
                    bNew = False
                End If
            Next x
        End If
    Next rw

    'dump the array to a worksheet
    ActiveWorkbook.Sheets("Sheet2").Range("A2").Resize(i, 2).Value = arr

End Sub