Question

我有一个电子表格，其中包含从第2行第1列开始的数据，并有42列。我正在尝试编写一个VBA代码，该代码将搜索我的数据的所有行（从第2行开始），并且如果第32列中的值大于575，则需要该代码在该行下方插入足够的行，以便无论值是（不论是600还是2,000）都可以按575的增量进行拆分。因此，例如，如果第5行第32列的值是800，我希望代码在第5行下方添加一行，并希望它用将第32列中的575的值替换为原始行中的值减去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

有没有一种方法可以在包含某些条件的行下方插入一定数量的行？

1 个答案: