在excel中插入行，并在特定单元格中显示值

Question

我正在使用此脚本插入填充行，其中在Excel文件的列中生成非顺序行。

Sub InsertValueBetween()
Dim lastrow As Long
Dim gap As Long
Dim i As Long, ii As Long

Application.ScreenUpdating = False

With ActiveSheet

    lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
    For i = lastrow To 3 Step -1

        gap = .Cells(i, "A").Value - .Cells(i - 1, "A").Value
        If gap > 1 Then

            .Rows(i).Resize(gap - 1).Insert

        End If

    Next i

    lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
    .Cells(3, "A").Value = .Cells(2, "A").Value + 1
    .Cells(2, "A").Resize(2).AutoFill .Cells(2, "A").Resize(lastrow - 1)

End With
End Sub

除了添加这些新行之外，我希望它们在列B中也有一个特定的值。我正在尝试实现它但没有结果。

有人可以帮帮我吗？

Answer 1

解决这一挑战的一种方法是使用Range变量。 以下是一些经过深思熟虑的代码，它贯穿整个过程：

Sub InsertValueBetweenRev2()
Dim Target As Range '<~ declare the range variable
'... declare your other variables

'... do other stuff

For i = lastrow To 3 Step -1
    gap = .Cells(i, "A").Value - .Cells(i - 1, "A").Value
    If gap > 1 Then
        .Rows(i).Resize(gap - 1).Insert
        'the next line sets the range variable to the recently
        'added cells in column B
        Set Target = .Range(.Cells(i, 2), .Cells(i + gap - 2, 2))
        Target.Value = "Cool" '<~ this line writes text "Cool" into those cells
    End If
Next i

'... the rest of your code

End Sub

总而言之，我们知道gap - 1将要添加gap - 1行，并且我们知道从第i行开始添加新行。 使用该知识，我们将列B中刚刚添加的单元格分配给Range然后将该Range的.value设置为所需的任何值。

Answer 2

用更少的变量和更快的速度做更好的方法：

Sub InsRowWithText()
Dim LR As Long, i As Long
LR = Range("D" & Rows.Count).End(xlUp).row
For i = LR To 3 Step -1
    If Range("D" & i).Value <> Range("D" & i - 1).Value Then
    Rows(i).Resize(1).Insert
    Range("D" & i).Value = "Test"
    End If
Next i
End Sub

这是我如何利用它：

Sub InsRowWithText()
Dim strMsg As String, strTitle As String
Dim LR As Long, i As Long

Text = "ADD"

    strMsg = "Warning: This is a Advanced Function, Continue? "
    strTitle = "Warning: Activated Advanced Function "
        If MsgBox(strMsg, vbQuestion + vbYesNo, strTitle) = vbNo Then
            Exit Sub
        Else
            Sheets("SAP Output DATA").Select

            If Range("D3").Value = Text Then
                MsgBox "Detected That This Step Was Already Completed, Exiting."
                Exit Sub
            End If
            application.ScreenUpdating = False
            LR = Range("D" & Rows.Count).End(xlUp).row
                For i = LR To 3 Step -1
                    If Range("D" & i).Value <> Range("D" & i - 1).Value Then
                    Rows(i).Resize(1).Insert
                    Range("D" & i).EntireRow.Interior.ColorIndex = xlColorIndexNone

                    Range(("A" & i), ("D" & i)).Value = Text
                End If
            Next i
        End If

            Range("D2").Select
            Selection.End(xlDown).Select
            ActiveCell.Offset(1).Select
            Range(("A" & ActiveCell.row), ("D" & ActiveCell.row)).Value = Text 'last row doesnt get text for some reason.
            ActiveCell.EntireRow.Interior.ColorIndex = xlColorIndexNone
            ActiveCell.Offset(1).Select
            Range(("D" & ActiveCell.row), ("E" & ActiveCell.row)).Interior.ColorIndex = 17 'purple

            application.ScreenUpdating = True

            Range("D3").Select

End Sub