VBA小工具：EXCEL如何批量给每行下面插入n个空行？

VBA小工具：EXCEL如何批量给每行下面插入n个空行？

引用

CSDN

1.

https://blog.csdn.net/xuemanqianshan/article/details/131581291

本文将介绍在Excel中批量给每行下面插入n个空行的多种方法，包括使用Excel本身的功能以及通过VBA脚本实现的两种不同方案。文章内容适合有一定Excel和VBA基础的读者学习参考。

Excel本身的方法

• 给每行加1个序号，也就是新增一个辅助列：序号列，比如1，2，3，
• 然后把要插入空行的区域，再其接着的下面行复制粘贴n份，你要插入多少个空行，就再复制n-1份
• 然后对辅助列：序号列排序
• 按照 升序排列即可
• 数据是否包含标题，自己酌情看，最多只有原始数据上有表头/或没表头，不能有多份表头

VBA实现1

粗糙代码

• 需要手动写死 行数范围的上限和下限

需要注意的问题

（1）

• 写循环时，需要注意一定要从下面往上面插入，否则区域往下循环时会被插入列打乱

（2）

• Cells(i + 1, 2).Insert 会导致不会整行下移，而只是这个单元格下移，根据需要改写
• ThisWorkbook.ActiveSheet.Cells(i + 1, 2).Insert shift:=xlDown ' 单元格下移
• ThisWorkbook.ActiveSheet.Rows(i + 1).Insert Shift:=xlDown ' 整行下移

（3）

• 内外层循环
• 内层循环，根据调用函数的参数得知要循环插入的行数 times
• 外层循环，本身的行数，也就是要执行的次数

（4）

• 从下面开始插入新行，那么最后1行如果下面没内容，就可以从 maxr1 - 1 行开始插入即可
• 插入行的时候要注意，EXCEL插入insert操作是再当前行的上面插入一行，所以实际执行时，需要使用 i+1 而不是 i .

Sub testcopy2()
    Call testcopy1(3)
End Sub
Function testcopy1(times)
   
   ' 写死要插入行的范围
   minr1 = 1
   maxr1 = 7
  '一定要从下面往上面插入，否则区域往下循环时会被插入列打乱
   For i = maxr1 - 1 To minr1 Step -1
       For j = 1 To times
'           Cells(i + 1, 2).Insert 会导致不会整行下移，而只是这个单元格下移，根据需要改写
'           ThisWorkbook.ActiveSheet.Cells(i + 1, 2).Insert shift:=xlDown
           ThisWorkbook.ActiveSheet.Rows(i + 1).Insert Shift:=xlDown
       Next j
   Next i
End Function

VBA实现2

改进代码：根据用户自己先选中的区域，进行插入空行操作。

用户可在EXCEL里选中区域，而不是改VBA代码

• 需要，用户先选中一个指定区域，比如 下图这样
• 让用户在EXCEL操作选中，比VBA里改参数还是友好的多

自动识别用户选择区域的行数范围

• 首先，无论是selection 还是 range 其 address属性，就包含了行列信息，有的应该还可以拆解为RIC1格式
• '需要处理Address "$B$1:$C$6" 取出 row的范围，minr-maxr
• '再从 "$B$1" 取到行数row

'需要处理Address "$B$1:$C$6" 取出 row的范围，minr-maxr
SA2 = Split(Selection.Address, ":")
For i = LBound(SA2) To UBound(SA2)
minr1 = SA2(0)
maxr1 = SA2(1)
Next
'再从 "$B$1" 取到行数row
minr1 = Right(SA2(0), Len(SA2(0)) - Application.Find("$", SA2(0), 2))
maxr1 = Right(SA2(1), Len(SA2(1)) - Application.Find("$", SA2(1), 2))

Sub testcopy2()
    Call testcopy1(5)
End Sub
Function testcopy1(times)
  '需要用户先在EXCEL手动选择一个区域Selection
  
  '需要处理Address "$B$1:$C$6" 取出 row的范围，minr-maxr
  SA2 = Split(Selection.Address, ":")
  For i = LBound(SA2) To UBound(SA2)
        minr1 = SA2(0)
        maxr1 = SA2(1)
  Next
 
  minr1 = Right(SA2(0), Len(SA2(0)) - Application.Find("$", SA2(0), 2))
  maxr1 = Right(SA2(1), Len(SA2(1)) - Application.Find("$", SA2(1), 2))
  
   For i = maxr1 - 1 To minr1 Step -1
       For j = 1 To times - 1
           ThisWorkbook.ActiveSheet.Rows(i + 1).Insert Shift:=xlDown
       Next j
   Next i
End Function

神奇的部分：用文心一言问了下给了我一个代码，是有问题的，但是可以拿来参考

文心一言给我的代码

• 执行效果是错的
• 问题1： 插入行没有倒着处理，所以代码执行会有问题
• 问题2： 内外层循环写的有问题

Sub InsertBlankRows1()
    Dim selectedRange As Range
    Dim numRows As Integer
    Dim i As Integer
      
    '获取选中区域
    Set selectedRange = Selection
      
    '获取要插入的空行数
    numRows = 3 '这里的数字3表示要插入3个空行
      
    '循环插入空行
    For i = 1 To numRows
        '在每行的下面插入一个空行
        For j = 1 To selectedRange.Rows.Count
            selectedRange.Rows(j).Offset(1).EntireRow.Insert Shift:=xlDown
        Next j
    Next i
      
End Sub