根据单元格值插入 X 行并格式化新行

Question

我在 Excel 2010 中有一个从第 10 行开始的数据表，每一行在 I 列中包含一个计算得出的数字 (X)。该代码旨在在表中的任何行下方插入 (X) 个新行(X) 大于 1。

当前代码实现了这一点，但随着新条目进入表中并且我再次运行代码，在已插入的附加行下方添加了更多空白行。

我还想将 A:G 列中的信息从包含 (X) 的行复制到每个新插入的行，并使原始行以粗体显示。

Sub Insert_SB()
Dim lngCounter As Long

For lngCounter = Range("I" & Rows.count).End(xlUp).row To 10 Step -1


    With Cells(lngCounter, "I")

    If IsNumeric(.Value) And .Value > 1 Then
    With .Offset(1, 0).Resize(.Value - 1, 1)
    .EntireRow.Insert
    End With
    If IsNumeric(.Value) And .Value = 0 Then Exit For

End If
End With

Next lngCounter

End Sub

Answer 1

您的代码将插入，例如在单元格 I11 中的数字 5 下方插入 5 个空白行。当你再次运行代码时，它会再次找到数字 5 并插入另外 5 行......你需要告诉它它不需要。也就是说，您需要先计算数字 5 下方的空白行，看看是否已经有 5 个，或者您需要将 5 标记为“完成”（也许通过写入 K 列）

这个函数可能会告诉你是否需要添加行：

Function NeedsMoreRows(rngToCheck As Range) As Boolean
Dim intNumBlankRows As Integer
Dim intCounter As Integer

    'this is the number of blank rows it should have underneath it
    intNumBlankRows = rngToCheck.Value

    For intCounter = 1 To intNumBlankRows

        If ActiveSheet.Cells(rngToCheck.Row + intCounter, rngToCheck.Column) <> vbNullString Then NeedsMoreRows = True


    Next intCounter



End Function

如果 IsNumeric(.Value) And .Value > 1 And NeedsMoreRows(Cells(lngCounter, "A")) 那么