Question

我需要在Excel中的每个当前数据区域之后插入2个空白行。

从理论上讲，我的代码应该可以工作并在数据之后插入它，但是在尝试了很多次之后，它会在数据之前插入它。

我哪里出错了？有人可以指导我吗？谢谢！

Sub AutoInsert2BlankRows()

Selection.CurrentRegion.Select
SendKeys "^{.}"
SendKeys "^{.}"
SendKeys "~"

ActiveCell.EntireRow.Select
'this chooses the whole row

Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
End Sub

以下是我的图片以供进一步澄清。如您所见，有3个不同的电流区域由空行分隔。我需要的是在已经存在的空行之外插入2个额外的空白行，以便在每个当前区域之间产生3个空行。（如果我之前不够清楚，请道歉。）

以下是image!

的链接

Answer 1

这是你想要做的吗？

第一个例子

Sub AutoInsert2BlankRows()

'   // Set Variables.
    Dim Rng As Range
    Dim i As Long

'   // Target Range.
    Set Rng = Range("A2:A10")

'   // Reverse looping
    For i = Rng.Rows.Count To 2 Step -1

'       // Insert two blank rows.
        Rng.Rows(i).EntireRow.Insert
        Rng.Rows(i).EntireRow.Insert

'   // Increment loop
    Next i


End Sub

修改

要在每个空行后添加两个空行，请尝试以下操作。

第二个例子

Sub AutoInsert2BlankRows() ' // Set Variables. Dim Rng As Range Dim i As Long ' // Target Range. Set Rng = Range("A2:A10") ' // Reverse looping For i = Rng.Rows.Count To 2 Step -1 If Cells(i, 1).Value = 0 Then ' // Insert two blank rows. Rng.Rows(i).EntireRow.Insert Rng.Rows(i).EntireRow.Insert End If ' // Increment loop Next i End Sub

第3个例子

Option Explicit Sub AutoInsert2BlankRows() ' // Set Variables. Dim Rng As Range Dim i As Long ' // Target Range. Set Rng = ActiveSheet.UsedRange ' // Reverse looping For i = Rng.Rows.Count To 1 Step -1 ' // If entire row is empty then If Application.CountA(Rows(i).EntireRow) = 0 Then ' // Insert blank row Rows(i).Insert Rows(i).Insert End If Next i End Sub

Answer 2

如果您在xlCellTypeConstants中使用Range.SpecialCells方法获取所有Worksheet.UsedRange property，则会有一些非连续的Areas。这些等同于Range.CurrentRegion property。循环浏览它们并根据需要插入行。

Sub autoInsertTwoBlankRows()
    Dim a As Long
    With Worksheets("Sheet1")
        With .UsedRange.SpecialCells(xlCellTypeConstants)
            For a = .Areas.Count To 1 Step -1
                With .Areas(a).Cells(1, 1).CurrentRegion
                    .Cells(.Rows.Count, 1).Offset(1, 0).Resize(2, .Columns.Count).Insert _
                      Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                End With
            Next a
        End With
    End With
End Sub

如果您的数据包含公式和类型常量，那么这更合适。

Sub autoInsertTwoBlankRows()
    Dim a As Long, ur As Range

    With Worksheets("Sheet1").Cells
        With Union(.SpecialCells(xlCellTypeConstants), _
                   .SpecialCells(xlCellTypeFormulas))
            For a = .Areas.Count To 1 Step -1
                With .Areas(a).Cells(1, 1).CurrentRegion
                    .Cells(.Rows.Count, 1).Offset(1, 0).Resize(2, .Columns.Count).Insert _
                      Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                End With
            Next a
        End With
    End With
End Sub

插入行时尝试从底部到顶部工作，以便替换行不会影响进一步的操作。这就是我从最后一个区域开始并朝着第一个区域开始工作的原因。

autoInsertTwoBlankRows 之前的^{数据岛
autoInsertTwoBlankRows}

之后的^数据岛

Answer 3

更新：感谢您的回复。

   Sub AutoInsert2BlankRows()
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
            .Calculation = xlCalculationManual
        End With

    Dim lastRow As Long, x As Long

    lastRow = Cells.Find(What:="*", _
                    After:=Range("A1"), _
                    LookAt:=xlPart, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious, _
                    MatchCase:=False).Row

    For x = lastRow To 2 Step -1

        If WorksheetFunction.CountA(Rows(x)) > 0 And WorksheetFunction.CountA(Rows(x + 1)) = 0 Then
            Rows(x + 1 & ":" & x + 2).Insert Shift:=xlDown
        End If

    Next

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With

End Sub

/预＆GT;

在A，B，C和E之后插入两行，但在D和E之间不插入，因为它们重叠。

Answer 4

（＆＃34;〜＆＃34;做什么？）

确保选择位于某个地区。您的代码Ctrl-.可能无法导航到最后一个单元格，具体取决于运行它时activecell的位置。我会用：

Dim rng As Range
Application.ScreenUpdating = False
Set rng = Selection.CurrentRegion
Set rng = rng(rng.Count + 1)    'the last cell + 1 row
rng.EntireRow.Rows("1:2").Insert shift:=xlDown

Answer 5

这对我有用，使用Excel 2007。

Sub AutoInsert2BlankRows()
Dim rng As Range

Set rng = Selection.End(xlDown).EntireRow
rng.Offset(1).Insert Shift:=xlDown
rng.Offset(1).Insert Shift:=xlDown

End Sub

我已经调整并简化了问题中的代码，主要是为了避免选择单元格。用户已在区域中选择了要在其后插入两行的单元格。变量rng首先移动到区域的底部，然后选择整个行。在rng之前插入两行，其中rng已偏移一行，以确保它们位于感兴趣的区域之后。我确定这两行可以作为一个命令插入，但我还不知道如何。

Answer 6

这不会在最后一个＆＃34;当前区域＆＃34;

之后添加额外的行

Sub AutoInsert2BlankRows()
    With Worksheets("mySheet").UsedRange '<-- change "mySheet" as per your actual sheet name
        With .Offset(, .Columns.Count).Resize(, 1)
            .FormulaR1C1 = "=IF(counta(RC1:RC[-1])>0,1,"""")"
            .Value = .Value
            With .SpecialCells(xlCellTypeBlanks).EntireRow
                .Insert Shift:=xlDown
                .Insert Shift:=xlDown
            End With
            .Clear
        End With
    End With
End Sub

在每个currentregion之后插入2个空行

6 个答案: