在每个 currentregion 之后插入 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 个不同的 currentregions 由空白行分隔。 我需要的是在已经存在的空白行之外插入 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

---

第三个​​例子

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

如果您在Worksheet.UsedRange property 中使用Range.SpecialCells 方法获取所有xlCellTypeConstants，您将拥有多个不连续的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

更新：感谢您的关注。

子 AutoInsert2BlankRows() 有应用程序 .ScreenUpdating = 假 .EnableEvents = 假 .Calculation = xlCalculationManual 结束于 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>

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

Answer 4

（“~”在做什么？）

确保所选内容位于该区域的某处。使用您的代码Ctrl-. 可能不会导航到最后一个单元格，具体取决于您运行它时活动单元格的位置。我会使用：

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

这不会在最后一个“当前区域”之后添加额外的行

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