繁体   English   中英

Excel 宏 - 复制行 -> 在下面插入行 -> 粘贴数据

[英]Excel Macro - Copy Row -> Insert Row under -> Paste data

我有一个贯穿 E 列的代码(下面的示例中的 C 列)并搜索数据的任何更改。 然后它在该更改下插入一个空白行并循环遍历数据集(200-500 行长)。 我正在寻找一种方法来在代码中修改/添加最后一行数据的“复制和粘贴”功能,在更改之前,将其添加到新插入的行中。

前:

A栏 B栏 立柱 C E 列
1 2 莎莉 5
1 2 莎莉 6
1 2 莎莉 2
1 2 追赶 1
1 2 追赶 4
1 2 9

后:

A栏 B栏 立柱 C E 列
1 2 莎莉 5
1 2 莎莉 6
1 2 莎莉 2
2 莎莉
1 2 追赶 1
1 2 追赶 4
2 追赶
1 2 9
2

我道歉。 新来的。 我目前拥有的代码有一个循环。 见打击:

Sub CleanUpPart2()

'Insert Rows by column F

'
    Dim iRow As Integer, iCol As Integer
    Dim oRng As Range

    Set oRng = Range("f1")

    iRow = oRng.Row
    iCol = oRng.Column

    Do
'
    If Cells(iRow + 1, iCol) <> Cells(iRow, iCol) Then
        Cells(iRow + 1, iCol).EntireRow.Insert Shift:=xlDown
        iRow = iRow + 2
    Else
        iRow = iRow + 1
    End If
'
    Loop While Not Cells(iRow, iCol).Text = ""
'

编辑::

请尝试更新的代码:

Sub testInsertRowCopyBefore()
  Dim sh As Worksheet, lastRow As Long, i As Long
  
  Set sh = ActiveSheet
  lastRow = sh.Range("A" & Rows.count).End(xlUp).row
  
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
   For i = lastRow + 1 To 3 Step -1
    If sh.Range("C" & i).Value <> sh.Range("C" & i - 1).Value Then
        sh.Range("C" & i).EntireRow.Insert xlUp
        sh.Range("B" & i & ":C" & i).Value = sh.Range("B" & i - 1 & ":C" & i - 1).Value
    End If
   Next i
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic
  MsgBox "Ready..."
End Sub

上面的代码假设“Column A”、“Column B”和“Column C”是标题,它们保留在工作表的第一行。

请测试它并发送一些反馈

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM