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

我需要在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个额外的空行，以便在每个currentregion之间创build3个空行。 （道歉，如果我不清楚的更早。）

这里是图像的链接！

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属性中的 Range.SpecialCells方法获取所有的xlCellTypeConstants ，则会有一些非连续的区域 。 这些等同于Range.CurrentRegion属性 。 循环通过它们，并随意插入行。

 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 

如果你的数据同时包含公式和types常量，那么这是更合适的。

 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（）
        与应用程序
             .ScreenUpdating = False
             .EnableEvents = False
             .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 

我已经调整和简化了问题中的代码，主要是为了避免select单元格。 用户已经select了他们想要插入两行之后的区域中的一个单元格。 variablesrng首先移动到该区域的底部，然后select整个行。 这两行插入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