在每行之后插入n个空白单元的代码非常慢

这将是我的代码，但如果我有超过5000行和1列，则需要一生。 有没有办法减less查询时间？

Sub InsertRows() Dim numRows As Integer Dim r As Long Application.ScreenUpdating = False r = Cells(Rows.Count, "A").End(xlUp).Row numRows = 11 For r = r To 1 Step -1 ActiveSheet.Rows(r + 1).Resize(numRows).Insert Next r Application.ScreenUpdating = True End Sub 

Answer 1

这花了1秒钟。

 Sub InsertRows() Dim numberOfValues As Long Dim i As Long Dim values As Variant Const numberOfEmptyRows As Long = 11 Application.ScreenUpdating = False ' count values in column A numberOfValues = Cells(Rows.Count, "A").End(xlUp).Row ' populate array with numbers ReDim values(1 To numberOfValues, 1 To 1) For i = 1 To numberOfValues values(i, 1) = i Next i ' I know there is a better way to do this part... Range(Cells(1, 2), Cells(numberOfValues, 2)).Value = values For i = 1 To numberOfEmptyRows - 1 Range(Cells(Rows.Count, "B").End(xlUp).Offset(1, 0), Cells(Rows.Count, "B").End(xlUp).Offset(numberOfValues, 0)).Value = values Next i ' sort by values inserted in column B Range(Cells(1, 1), Cells(Rows.Count, "B").End(xlUp)).Sort Key1:=Range("B1"), _ Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal Columns("B:B").EntireColumn.Delete Application.ScreenUpdating = True End Sub 

此代码使用助手列（在本例中为B）在目标范围旁边插入数字序列。 然后在它下面加上相同的数字N次，并在那一列上sorting。 最后，它删除列。 这是如何快速插入空白行到任何数据集。

更改Const numberOfEmptyRows As Long = 11如果你想插入更多/更less的空白行。 在打击Excel的行限制之前，此技术可以处理多less条logging（以及可以插入多less个空行）是有限制的。

Answer 2

吉米，你的代码非常好。 但如果“A”栏中没有任何内容，而其他栏有一些sorting的结果会出错。

所以，我将使用UsedRange获取如下的numberOfValues。

  Set r2Arrange = ActiveSheet.UsedRange 

在列A中计数值：

 numberOfValues = r2Arrange.Rows.Count