时间戳

首页 > 解决方案 > 有没有办法在包含某些条件的行下方插入一定数量的行？

excel - 有没有办法在包含某些条件的行下方插入一定数量的行？

问题描述

我有一个电子表格，其中包含从第 2 行第 1 列开始的数据，并且有 42 列。我正在尝试编写一个 VBA 代码，它将搜索从第 2 行开始的所有数据行，如果第 32 列中的值大于 575，我需要代码在该行下方插入足够的行，以便无论该值是什么（无论是 600 还是 2,000）都可以分成 575 的增量。例如，如果第 5 行第 32 列的值为 800，我希望代码在第 5 行下方添加一行，并且我希望它自动填充新行第 32 列中 575 的值，并将原始行中的值替换为负 575。此外，在我的数据的第一列中，我有日期。对于创建的每个新行，我希望它比原始行中的日期早一周。这是我的数据的示例：

第 1 列 ...第 32 列.......第 42 列

2019 年 8 月 15 日 // 3873

这是我运行代码后希望它的样子。

第 1 列……第 32 列……第 42 列

2019 年 8 月 15 日 // 423

2019 年 8 月 8 日 // 575

2019 年 8 月 1 日 // 575

2019 年 7 月 25 日 // 575

2019 年 7 月 18 日 // 575

2019 年 7 月 11 日 // 575

2019 年 7 月 4 日 // 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 的增量所需的许多行，并在创建的每一行中减去一周。预先感谢您的帮助。

标签： excelvba

解决方案

有很多方法可以实现目标。一种是代替反向循环，您向下插入余额金额，然后在下一行重新计算，依此类推，直到遇到空白。可以尝试使用临时数据测试的代码

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

推荐阅读