在不等值后插入Cell,复制,然后删除插入的行

时间:2013-10-21 18:17:33

标签: loops excel-vba vba excel

您好我已经创建了以下两个宏,但它在最后一个单元格后面插入一行数据。我相信这是我的循环条件为Do Until ActiveCell.Value = ""的结果。我想让循环停在最后一个包含数据的单元格。

我尝试使用变量Do Until Loop_Long = LastRow,但这对我不起作用。

我想要的是在具有不同数据的单元格之间插入宏。然后是一个宏,它将在列中找到空单元格,我们之前插入的单元格,然后删除该行。

如上所述,问题是它是插入一个额外的行而不是删除它,如果您在A列中的数据之后将值一直放在B列下,您将看到我的意思。

这是我的代码:

Option Explicit

Sub Macro1()
'Insert Blank Row Between Names
Sheets("Sheet1").Select

Range("A1").Select
Do Until ActiveCell.Value = ""
    If ActiveCell.Value <> ActiveCell.Offset(1).Value Then
        ActiveCell.Offset(1).EntireRow.Insert
        ActiveCell.Offset(1).Select
    End If
    ActiveCell.Offset(1).Select
 Loop
End Sub

Sub Macro2()

Dim LastRow As Long

'Delete Inserted Rows
Sheets("Sheet1").Select
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Range("A" & LastRow).Select
Do Until ActiveCell.Value = Range("A1")
    If ActiveCell.Value <> ActiveCell.Offset(-1).Value Then
        ActiveCell.Offset(-1).EntireRow.Delete Shift:=xlUp
        ActiveCell.Offset(-1).Select
    End If
    ActiveCell.Offset(-1).Select
Loop
End Sub

1 个答案:

答案 0 :(得分:0)

根据您的说法,以下代码应该适合您(并且最好遵循最佳实践)...您是否考虑过按原样复制数据,然后在粘贴数据后插入行新的位置?那将会迈出一步。

Option Explicit
'Declare module-level variables.
Dim sht As Worksheet
Dim Cell As Range
Dim NameRng As Range
Dim LastRow As Long

Sub test()
'Add blank rows.
Set sht = ActiveWorkbook.Sheets("Sheet1")
LastRow = sht.Range("A" & Rows.count).End(xlUp).Row

Set NameRng = sht.Range("A1:A" & LastRow)

For Each Cell In NameRng
    If Cell <> Cell.Offset(1, 0) And Cell <> "" Then
        Cell.Offset(1, 0).EntireRow.Insert
    End If
Next Cell

End Sub
Sub test2()
'Delete blank rows.
Set sht = ActiveWorkbook.Sheets("Sheet1")
LastRow = sht.Range("A" & Rows.count).End(xlUp).Row

Set NameRng = sht.Range("A1:A" & LastRow + 1)

For Each Cell In NameRng
    If Cell = "" Then
        Cell.EntireRow.Delete
    End If
Next Cell

End Sub