在excel中插入行，并在特定的单元格中添加一个值

我正在使用这个脚本来插入一个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

你可以用一个Rangevariables来解决这个问题。 以下是一些经过深思熟虑的代码：

 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行将被添加，并且我们知道新行从第i行开始被添加。 使用这些知识，我们将列B中刚刚添加的单元格分配给Range然后将该Range的.value值设置为所需的值。

Answer 2

用更less的variables和更快的方法做一个更好的方法：

 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