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

Question

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

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次相同的数字,并对该列进行排序.最后,它删除列.这是您可以快速将空行插入任何数据集的方法.

Const numberOfEmptyRows As Long = 11如果要插入更多/更少的空行,请更改.在达到Excel的行限制之前,此技术可以处理多少条记录(以及可以插入多少空行)是有限制的.