行插入在循环中很慢

Question

我需要在作品中插入行sheet。

我必须根据某些条件插入大约 350 行，这大约需要 30-40 分钟。

下面是我的 VBA 代码：

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

For index = CardetailInfoStartRow To (CardetailInfoStartRow + CardetailRecordCount - 1)
    If IsError(CardetailDistance) = False Then
        If Len(Trim(CardetailDistance)) > 0 Then                    
            Sheets("Cars").Rows(rowIndexToInsert).Insert Shift:=xlDown
            Sheets("Cars").Range("B" & rowIndexToInsert & ":EA" & _
              rowIndexToInsert).Value = "Cardetail " & _
              Sheets("Cars").Range("I" & index).Value & ", " & CardetailDistance
            Sheets("Cars").Range("B" & rowIndexToInsert & ":EA" & rowIndexToInsert).Select
            With Selection
                .VerticalAlignment = xlTop
                .WrapText = True
                .Orientation = 0
                .AddIndent = False
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = True
                .RowHeight = 23                                
            End With
            rowIndexToInsert = rowIndexToInsert + 1
        End If
    End If
Next index

sheet 包含一些条件格式的单元格。

通过一些解决方案，有这个解决方案可以禁用条件格式。我尝试使用 VBA 但性能仍然没有提高。在方法执行之前插入了以下代码。

Range("F1:EA" & Range("car_count").Value - 1).Select
Selection.Interior.ColorIndex = xlNone
Selection.Cells.FormatConditions.Delete

是否有其他方法可以提高性能？

Answer 1

根据评论，我能够为此实施解决方案。不是逐行插入行，而是通过计算需要插入的行数来完成单次插入。现在只需不到一分钟的时间即可执行

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

If CarDetailInfoStartRow > 0 And CarDetailRecordCount > 0 Then
            Dim recCount As Integer
            recCount = 0

            For index = CarDetailInfoStartRow To (CarDetailInfoStartRow + CarDetailRecordCount - 1)
                CarDetailSplitLimit = Sheets("Cars").Range("BF" & index).Value
                If IsError(CarDetailSplitLimit) = False And Len(Trim(CarDetailSplitLimit)) > 0 Then
                    recCount = recCount + 1
                End If
            Next index
            If recCount > 0 Then
                Sheets("Cars").Rows(rowIndexToInsert).EntireRow.Offset(1).Resize(recCount).Insert Shift:=xlDown
            End If


For index = CardetailInfoStartRow To (CardetailInfoStartRow + CardetailRecordCount - 1)
 If IsError(CardetailDistance) = False Then
                    If Len(Trim(CardetailDistance)) > 0 Then                    
                        Sheets("Cars").Rows(rowIndexToInsert).Insert Shift:=xlDown
                        Sheets("Cars").Range("B" & rowIndexToInsert & ":EA" & rowIndexToInsert).Value = "Cardetail " & Sheets("Cars").Range("I" & index).Value & ", " & CardetailDistance
                        Sheets("Cars").Range("B" & rowIndexToInsert & ":EA" & rowIndexToInsert).Select
                        With Selection
                            .VerticalAlignment = xlTop
                            .WrapText = True
                            .Orientation = 0
                            .AddIndent = False
                            .ShrinkToFit = False
                            .ReadingOrder = xlContext
                            .MergeCells = True
                            .RowHeight = 23

                        End With
                        rowIndexToInsert = rowIndexToInsert + 1
                    End If
                End If
            Next index

行插入在循环中很慢

Row Insert is slow inside a loop

excel

vba

conditional-formatting