当单元格值较大时插入行答案

【问题标题】：Insert row when Cell Value is Greater当单元格值较大时插入行
【发布时间】：2020-07-20 17:52:56
【问题描述】：

Here is my Sheet 我在其中写了这段代码

     Sub L()
        Dim rng As Range, cell As Range
        Set rng = Range("P12:P1322")
        For Each cell In rng
        If cell.Value > 12 Then
        cell.Interior.ColorIndex = 3
        ActiveCell.Range(rng).Activate
        Copy.selection
        Range(rng).Offset(1, 0).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrAbove
       'Range(rng).Offset(1).EntireRow.PasteSpecial xlPasteFormats
        End If
        
        Next cell
        End Sub

我也尝试了另一个代码，但它不起作用。您会看到红色单元格这些单元格的值大于 12 我想在活动行下方添加具有相同格式的行。

【问题讨论】：

如果要插入行，则需要自下而上循环。
你能用文字解释一下你想让代码做什么。该代码没有在任何地方添加任何行。另外，您的工作表中实际上是否有一个名为 "rng" 的范围？你的意思是ActiveSheet.Range("rng").Activate 而不是ActiveCell...？你为什么要激活这个范围？除了让你的代码运行慢得多之外，它似乎没有做任何事情。
@SuperSymmetry 看到我想在一个范围内循环检查单元格值是否大于 12，如果它是真的，然后在我尝试之前添加与上面相同格式的活动范围下方的行它只是移动单元格而不是行的活动单元格。

标签： excel vba loops format range

【解决方案1】：

我认为这应该做你想做的事

Sub L()
    Dim i As Long
    With Range("P12:P1322")
        For i = .Rows.Count To 12 Step -1
            If .Cells(i, 1).Value > 12 Then
                .Cells(i, 1).Interior.ColorIndex = 3
                .Cells(i + 1, 1).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            End If
        Next i
    End With
End Sub

以下明显更快

Sub LImproved()
    Dim dStart As Double
    dStart = Timer
    
    Dim i As Long
    Dim lCol As Long: lCol = 16 ' column P
    Dim lLastRow As Long
    Dim sRows As String
    
    With ThisWorkbook.Sheets("Sheet1")
        lLastRow = .Cells(.Rows.Count, lCol).End(xlUp).Row
        'lLastRow = 1322
    
        For i = lLastRow To 12 Step -1
            If .Cells(i, lCol).Value > 12 Then
                sRows = sRows & i + 1 & ":" & i + 1 & ","
                If Len(sRows) > 235 Then
                    UpdateFormats Left(sRows, Len(sRows) - 1), lCol
                    sRows = ""
                End If
            End If
        Next i
        If sRows <> "" Then UpdateFormats Left(sRows, Len(sRows) - 1), lCol
    End With
    
    MsgBox "Time taken: " & Format(Timer - dStart, "0.00s")
End Sub

Sub UpdateFormats(sRows As String, lCol As Long)
    With ThisWorkbook.Sheets("Sheet1")
        With Intersect(.Range(sRows), .Columns(lCol)).Offset(-1, 0)
            .Interior.ColorIndex = 3
        End With
        With .Range(sRows)
            .Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        End With
    End With
End Sub

【讨论】：

Thnx Mate 成功了