在每个当前区域后插入 2 个空行

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 个空白行。（抱歉，如果我之前不够清楚。）

这里是 link 到 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

编辑

To add two more blank rows after each blank row, try the following.

第二个例子

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

第三个例子

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 with Range.SpecialCells method within the Worksheet.UsedRange property, you will have a number of non-contiguous Areas. These equate to the 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

（“~”在做什么？）

确保选择在某处的区域中。使用您的代码 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 4

这对我有用，使用 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 5

更新：感谢您的关注。

   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

/pre>

Two rows were inserted after A, B, C and E but not between D and E because they overlap.

Answer 6

这不会在最后一个 "current region"

之后添加额外的行

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

在每个当前区域后插入 2 个空行

Insert 2 blank rows after every currentregion

excel

vba

sendkeys