VBA вставка row_dynamic

Question

Ниже приведен фрагмент кода в VBA, который в основном не вставляет ни одной строки на основе количества, присутствующего в конкретной ячейке. Теперь я хочу изменить код таким образом, чтобы ни одна из строк, которые будут вставлены, не была бы на одну единицу меньше, чемсчитать присутствующим в конкретной ячейке.например, если в определенном столбце и определенном количестве ячеек = N, макрос будет запущен и добавит N нет строк. Теперь я хочу, чтобы строки добавлялись на единицу меньше, т.е. N-1

Sub InsertRowsIf()
Dim lr As Long, R As Range, i As Long
lr = Range("R" & Rows.Count).End(xlUp).Row
Set R = Range("R3", "R" & lr)
Application.ScreenUpdating = False
For i = R.Rows.Count To 1 Step -1
If IsNumeric(R.Cells(i, 1).Value) And Not IsEmpty(R.Cells(i, 1)) Then
R.Cells(i, 1).Offset(1, 0).Resize(R.Cells(i, 1).Value).EntireRow.Insert
End If
Next i


End Sub

Answer 1

Я думаю, что попытка вставить использование R в качестве диапазона вызывает проблемы.Это не нужно.

Sub InsertRowsIf()

Dim ws As Worksheet
Set ws = Worksheets("Sheet1") ' Change to your sheet

Dim lr As Long
lr = ws.Range("R" & Rows.Count).End(xlUp).Row

Application.ScreenUpdating = False

Dim i As Long
For i = lr To 3 Step -1
    If IsNumeric(ws.Cells(i, 18).Value) And ws.Cells(i, 18) <> "" Then
        ws.Cells(i, 1).Offset(1,0).Resize(ws.Cells(i, 18).Value - 1).EntireRow.Insert
    End If
Next i

Application.ScreenUpdating = True

End Sub

Answer 2

Вы забыли включить ScreenUpdating обратно.Обновлен код для пропуска последней строки и применен стандартный отступ.

Option Explicit

Sub InsertRowsIf()

Dim lr As Long, R As Range, i As Long

lr = Range("R" & Rows.Count).End(xlUp).Row
Set R = Range("R3:R" & lr - 1)

Application.ScreenUpdating = False
    For i = R.Rows.Count To 1 Step -1
        If IsNumeric(R.Cells(i, 1).Value) And Not IsEmpty(R.Cells(i, 1)) Then
            R.Cells(i, 1).Offset(1, 0).Resize(R.Cells(i, 1).Value).EntireRow.Insert
        End If
    Next i
Application.ScreenUpdating = True

End Sub