使用VBA在Excel中批量插入多行及指定内容的问题求助

我在工作表里有一个项目列表，想要在每个项目下方插入两行，并给每个项目添加Test、Install这两个固定任务。现有的VBA代码会把所有新增行都加到工作表顶部，而不是对应项目的下方（代码前半部分是用来清理不需要的行的）。我查了很多视频和代码资料，改了好多次还是实现不了需求。

原始表格 #

目标效果 #

现有VBA代码 #

Sub DeleteRowsBasedonCellValue()
    
    'Declare Variables
    Dim LastRow As Long, FirstRow As Long
    Dim Row As Long

    With ActiveSheet
       'Define First and Last Rows
       FirstRow = 1
       LastRow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
       LastRow = ActiveSheet.UsedRange.Rows.Count
       'MsgBox LastRow

       'Loop Through Rows (Bottom to Top)

       For Row = LastRow To FirstRow Step -1
           If .Range("C" & Row).Value = "0" Then
              .Range("C" & Row).EntireRow.Delete
           End If
       Next Row

    End With

    With ActiveSheet
        FirstRow = 1
        LastRow = .UsedRange.Rows(.UsedRange.Rows.Count).Row

        For Row = LastRow To FirstRow Step -1
            If .Range("C" & Row).Value <> "" Then
                Rows("3:7").Insert Shift:=xlDown
                'Range("D" & FirstRow).Value = "Ross"
                FirstRow = FirstRow + 1
            End If
        Next Row
    End With

End Sub

现有代码的核心问题是插入行时用了固定行号Rows("3:7").Insert，逻辑完全错误，没针对当前项目行的位置操作。以下是修正后的代码：

Sub AddTasksAfterProjects()
    Dim LastRow As Long
    Dim Row As Long
    
    ' 第一步：清理C列为0的行（保留原需求逻辑）
    With ActiveSheet
        LastRow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
        ' 从下往上遍历删除，避免行号错乱
        For Row = LastRow To 1 Step -1
            If .Range("C" & Row).Value = "0" Then
                .Rows(Row).EntireRow.Delete
            End If
        Next Row
        
        ' 重新获取清理后的最后一行行号
        LastRow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
        
        ' 第二步：为每个项目插入任务行，从下往上遍历避免插入后行号混乱
        For Row = LastRow To 1 Step -1
            ' 假设A列（Function列）有内容即为项目行
            If .Range("A" & Row).Value <> "" Then
                ' 在当前项目行下方插入两行
                .Rows(Row + 1 & ":" & Row + 2).Insert Shift:=xlDown
                ' 填充Test和Install到B列对应位置
                .Range("B" & Row + 1).Value = "Test"
                .Range("B" & Row + 2).Value = "Install"
            End If
        Next Row
    End With
End Sub

关键调整说明 #

• 删掉了原代码中冗余的行号定义，优化了行号获取逻辑
• 插入行时不再用固定行号，而是基于当前项目行的行号动态指定插入位置，确保新增行出现在对应项目下方
• 插入后直接填充Test和Install，无需后续手动操作
• 全程保留从下往上遍历的方式，避免插入行导致后续行号错乱的问题

内容的提问来源于stack exchange，提问作者Angus Thermopily