如何解决Excel 宏 - 复制行 -> 在下方插入行 -> 粘贴数据
我有一个代码,它贯穿 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
上面的代码假设“A 列”、“B 列”和“C 列”是标题,它们保留在工作表的第一行。
请测试并发送一些反馈
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。