excel - 需要将行剪切并粘贴到上一行的末尾

Question

我正在为我的数据分析工作学习 VBA。我已经弄清楚我需要在这里使用多个“IF”语句以及复制和粘贴来做什么，但 VBA 会更干净。

我有来自我们医疗系统的数千行数据，它们以每条记录两行的形式进入 Excel。我想取第二行（单元格 A - J）并将其剪切并粘贴到第一行的末尾，从 J 处的第一个空单元格开始。

我尝试了许多不同的宏，但每个宏只完成我需要的一部分，而不是整个过程。我还没有找到其他人正在这样做。任何帮助，将不胜感激。

    Sub CutMove()
    '
    ' CutMove Macro
    ' Cut and move 2nd Pt record row to column H of first
    '
    Dim X As Integer
        For X = 1 To 15 Step 3
            Range(Cells(3, 1), Cells(3, 10)).Select
            Selection.Cut
            Range("H" & X).Select
            ActiveSheet.Paste
        Next X
    End Sub

            Sub StackCopy_2()
     For Row = 2 To 15 Step 2
        Range("A3:J3" & Row).Cut
         ActiveSheet.Paste Destination:=Range("J" & Row - 1)
    Next Row
    End Sub

Excel 文件截图：

标签： excelvba

Answer 1

在复制和清除之前，我已使用样本数据生成基本检查。这可能应该进行调整以适应更广泛的实际数据。

Option Explicit

Sub StackCopy()

    Dim i As Long

    With Worksheets("sheet9")

        'shuffle data up and right
        For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row Step 2
            'simple check to see if column A follows pattern
            If Left(.Cells(i, "A"), 2) = "ER" And IsNumeric(.Cells(i + 1, "A")) Then
                .Cells(i, "J").Resize(1, 10) = .Cells(i + 1, "A").Resize(1, 10).Value
                .Cells(i + 1, "A").Resize(1, 10).Clear
            End If
        Next i

        'remove the blank rows
        With .Range(.Cells(1, "A"), .Cells(.Rows.Count, "A").End(xlUp))
            .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        End With

    End With

End Sub