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

最新推荐文章于 2024-09-01 11:23:49 发布

奔跑的犀牛先生

最新推荐文章于 2024-09-01 11:23:49 发布

阅读量3.6k

点赞数 3

文章标签： excel

本文链接：https://blog.csdn.net/xuemanqianshan/article/details/131581291

版权

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

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

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

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

4.1 文心一言给我的代码

1EXCEL本身的方法

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

2 VBA实现1：

2.1 粗糙代码

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

2.2 需要注意的问题

（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

3 VBA实现2：

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

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

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

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

首先，无论是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

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

4.1 文心一言给我的代码

执行效果是错的
问题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