Как вставить количество строк на основе критериев значения в столбце

Question

Я часами пытался найти правильный код. У меня уже есть подпрограмма Sub, и это следующий шаг в подпрограмме.

У меня есть набор данных, в который я хочу вставить 3 строки, если столбец ("C: C") < 1

Далее по модулю у меня есть: Dim ws As Worksheet Set ws = Workseets ("Report1")

Я не знал, нужно ли мне устанавливать другой DIM .. Это что у меня есть:

'Вставить 3 пустых строки после $ Share <1.0 </p>

With ws
    If Range("C:C").Value < "1.0" Then
    Rows.EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    End If
End With

Но я получаю ошибку времени выполнения' 13 ': Несоответствие типов

Спасибо за помощь!

Answer 1

При добавлении или удалении строк лучше всего работать от нижней части листа до верха:

Dim i As Long, lr As Long, ws As Worksheet

Set ws = ActiveSheet

lr = ws.Cells(ws.Rows.Count, 3).End(xlUp).Row

For i = lr To 2 Step -1
    With ws.Cells(i, 3)
        If Len(.Value) > 0 And .Value < 1 Then
            .Offset(1, 0).Resize(3, 1).EntireRow.Insert
        End If
    End With
Next i

РЕДАКТИРОВАТЬ: для вашего исправленного описания

For i = 2 To lr
    With ws.Cells(i, 3)
        If Len(.Value) > 0 And .Value < 1 Then
            .Offset(1, 0).Resize(3, 1).EntireRow.Insert
            Exit For
        End If
    End With
Next i

Dim i As Long, n As Long, lr As Long, ws As Worksheet
Dim c As Range

РЕДАКТИРОВАТЬ 2: добавлять строки выше <1 значения </p>

Set ws = ActiveSheet
Set c = ws.Cells(ws.Rows.Count, 3).End(xlUp)
Do While c.Row > 1
    If Len(c.Value) > 0 And c.Value < 1 Then
        'insert 3 rows above
        For n = 1 To 3
            c.EntireRow.Insert
            Set c = c.Offset(-1, 0) '<<adjust for added row
        Next n
        Exit Do '<< stop checking
    End If
    Set c = c.Offset(-1, 0)
Loop