Есть ли способ вставить определенное количество строк ниже строки, которая содержит определенные критерии?

Question

У меня есть электронная таблица, которая содержит данные, начиная со строки 2, столбец 1, и содержит 42 столбца. Я пытаюсь написать код VBA, который будет искать все строки моих данных, начиная со строки 2, и, если значение в столбце 32 больше 575, мне нужен код для вставки достаточного количества строк ниже этой строки, чтобы любое значение было ( будь то 600 или 2000) можно разделить на 575. Так, например, если значение столбца 32 строки 5 равно 800, я хочу, чтобы код добавил строку ниже строки 5, и я хочу, чтобы он автоматически заполнял новую строку с помощью значение 575 в столбце 32 и замените значение в исходной строке тем, что было минус 575. Кроме того, в первом столбце моих данных у меня есть даты. Для каждой новой создаваемой строки я хочу, чтобы она была на неделю раньше даты в исходной строке. Вот пример того, как выглядят мои данные:

Столбец1 ... Столбец 32 ....... Столбец 42

8/15/2019 // 3873

Вот как я хочу, чтобы он выглядел после запуска кода.

Столбец1 ... Столбец 32 ...... Столбец 42

8/15/2019 // 423

8/8/2019 // 575

8/1/2019 // 575

7/25/2019 // 575

7/18/2019 // 575

7/11 / 2019 // 575

7/4/2019 // 575

Косые метки только для того, чтобы показать разделение в столбцах. И я хочу, чтобы данные из всех других столбцов остались такими же, как в строке выше. Есть ли хороший способ сделать это?

Это код, который я придумал до сих пор. Однако проблема в том, что я не могу понять, как его запрограммировать, чтобы он знал, сколько строк добавить, исходя из того, насколько велико количество. На данный момент он просто добавляет строку под любой строкой, значение столбца 32 которой больше 575. Кроме того, он просто добавляет пустые строки. В моем коде нет ничего, что бы указывало, какие значения нужно поместить во вновь созданные строки

Sub BlankLine()

Dim Col As Variant
Dim BlankRows As Long
Dim LastRow As Long
Dim R As Long
Dim StartRow As Long
Dim LargeOrder As Integer

    Col = "AF"
    StartRow = 1
    BlankRows = 1
    LargeOrder = 575

        LastRow = Cells(Rows.Count, Col).End(xlUp).Row
        Application.ScreenUpdating = False

        With ActiveSheet
        For R = LastRow To StartRow + 1 Step -1
        If .Cells(R, Col).Value > LargeOrder Then
        .Cells(R + 1, Col).EntireRow.Insert Shift:=xlDown
        End If
        Next R
        End With
        Application.ScreenUpdating = True

        End Sub

Как я упоминал ранее, мне нужен код, чтобы добавить столько строк, сколько нужно для размещения исходного количества, с разбивкой по 575, а также вычесть неделю с каждой созданной строкой. Заранее благодарю за помощь.

Answer 1

Есть множество способов достижения цели. Один вместо обратного цикла, вы переходите вниз, вставляя сумму остатка, и снова пересчитываетесь в следующую строку и так далее, пока не встретится пробел. Может попробовать код, проверенный с временными данными

Option Explicit
Sub addLine()
Dim Col As Variant
'Dim BlankRows As Long
'Dim LastRow As Long
Dim R As Long
Dim StartRow As Long
Dim LargeOrder As Integer

Dim Ws As Worksheet
Dim ActNum As Double, Balance As Double
Set Ws = ThisWorkbook.ActiveSheet
Col = "AF"
StartRow = 2
'BlankRows = 1
LargeOrder = 575

R = StartRow
  With Ws
  ActNum = .Cells(R, Col).Value
    Do While ActNum <> 0
        If ActNum > LargeOrder Then
        .Cells(R + 1, Col).EntireRow.Insert Shift:=xlDown
        .Range(.Cells(R, 1), .Cells(R, 42)).Copy Destination:=.Cells(R + 1, 1)
        .Cells(R + 1, 1).Value = .Cells(R + 1, 1).Value - 7
         'simpler calculation 
         Balance = IIf(ActNum Mod LargeOrder > 0, Int(ActNum / LargeOrder) * LargeOrder, ActNum - LargeOrder)
        'Balance = IIf(ActNum Mod LargeOrder > 0, Int(ActNum / LargeOrder) * LargeOrder, Int(ActNum / LargeOrder) * LargeOrder - LargeOrder)
        .Cells(R + 1, Col).Value = Balance
        .Cells(R, Col).Value = ActNum - Balance
        End If
    R = R + 1
    ActNum = .Cells(R, Col).Value
    Loop
  End With
End Sub

Редактировать: может попробовать измененный код ниже для отклонения в требовании

Option Explicit
Sub addLine2()
Dim Col As Variant
Dim LastRow As Long
Dim R As Long, i As Long
Dim StartRow As Long
Dim RowtoAdd As Long

Dim Ws As Worksheet
Dim ActNum As Double, Balance As Double
Set Ws = ThisWorkbook.ActiveSheet
Col = "AS"
StartRow = 2
LastRow = Ws.Cells(Rows.Count, Col).End(xlUp).Row

R = StartRow
  With Ws

    Do
    RowtoAdd = .Cells(R, Col).Value
    LastRow = LastRow + RowtoAdd
        For i = 1 To RowtoAdd
        .Cells(R + 1, Col).EntireRow.Insert Shift:=xlDown
        .Cells(R, 1).EntireRow.Copy Destination:=.Cells(R + 1, 1)
        .Cells(R + 1, 1).Value = .Cells(R + 1, 1).Value - 7
        .Cells(R + 1, 32).Value = ""
        R = R + 1
        Next i
    R = R + 1
    Loop Until R > LastRow
  End With
End Sub