Excel VBA - 在特定文本上方插入行并复制格式和公式

Question

我发现我有类似的问题，但是我找不到包含我的两个查询的 VBA。我对 VBA 相当陌生，因此正在努力将两个代码组合成一个代码：

在包含文本“TTDASHINSERTROW”的行上方插入指定数量的行，并从上面的行复制格式和公式。

我的第一个代码插入了许多行并从上面复制公式，但基于“活动单元格”。

Sub insertRow()

Dim Rng, n As Long, k As Long
Application.ScreenUpdating = False
Rng = InputBox("Enter number of rows required.")
If Rng = "" Then Exit Sub
Range(ActiveCell, ActiveCell.Offset(Val(Rng) - 1, 0)).EntireRow.Insert
'need To know how many formulas To copy down.
'Assumesfrom A over To last entry In row.
k = ActiveCell.Offset(-1, 0).Row
n = Cells(k, 256).End(xlToLeft).Column
Range(Cells(k, 1), Cells(k + Val(Rng), n)).FillDown

End Sub

第二个代码基于对文本“TTDASHINSERTROW”的搜索插入一行。

Sub insertRow()

  Dim c As Range
  For Each c In Range("A:A")
    If c.Value Like "*TTDASHINSERTROW*" Then
        c.Offset(1, 0).EntireRow.Insert
    End If
  Next c

End Sub

任何将这些组合成单个代码的帮助，该代码可以在指定文本上方插入指定数量的行并复制格式和公式，我们将不胜感激。

更新

我想出了以下代码，它允许用户在运行宏时通过弹出窗口添加指定数量的行。该代码仍然需要一个活动单元格并从该单元格上方复制公式。

Sub InsertRow()

Dim d As Integer
d = Range("A:A").End(xlDown).Row
Dim c As Range
For i = d To 1 Step -1
If Cells(i, 1).Value Like "TTDASHINSERTROW" Then

Dim Rng, n As Long, k As Long
Application.ScreenUpdating = False
Rng = InputBox("Enter number of rows required.")
If Rng = "" Then Exit Sub

Range(ActiveCell, ActiveCell.Offset(Val(Rng) - 1, 0)).EntireRow.Insert
'need To know how many formulas To copy down.
'Assumesfrom A over To last entry In row.

k = ActiveCell.Offset(-1, 0).Row
n = Cells(k, 256).End(xlToLeft).Column
Range(Cells(k, 1), Cells(k + Val(Rng), n)).FillDown


End If
Next
End Sub

除了引用活动单元格的代码的第二部分之外，它是否可以找到带有“TTDASHINSERTROW”的单元格并从该行上方复制公式和格式？

很遗憾，我没有足够的代表来附上屏幕截图。

Answer 1

Sub insertRow()
Dim Rng As Long
Rng = InputBox("Enter number of rows required.")
If Rng = 0 Then Exit Sub
Application.ScreenUpdating = False 'this is unnecessary unless you often get seizures
LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 'tells the number of rows used
LastColumn = Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column 'tells the number of columns used

  For i = 1 To LastRow 'for each row
    If Cells(i, 1).Value Like "*TTDASHINSERTROW*" Then 'if Range("A"&i) is like your string
        For j = 1 To Rng
            Rows(i).EntireRow.Insert
            Range(Cells(i, 1), Cells(i + 1, LastColumn)).FillUp
        Next
    End If
  Next

Application.ScreenUpdating = True
End Sub

Answer 2

已解决。

我需要对我的代码做的只是包含一个“查找”函数，该函数定位包含“TTDASHINSERTROW”的单元格，从而使该单元格成为活动单元格。

Sub InsertRow()


Cells.Find(What:="TTDASHINSERTROW", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

Dim d As Integer
d = Range("A:A").End(xlDown).Row
Dim c As Range
For i = d To 1 Step -1
If Cells(i, 1).Value Like "TTDASHINSERTROW" Then

Dim Rng, n As Long, k As Long
Application.ScreenUpdating = False
Rng = InputBox("Enter number of rows required.")
If Rng = "" Then Exit Sub

Range(ActiveCell, ActiveCell.Offset(Val(Rng) - 1, 0)).EntireRow.Insert
'need To know how many formulas To copy down.
'Assumesfrom A over To last entry In row.

k = ActiveCell.Offset(-1, 0).Row
n = Cells(k, 256).End(xlToLeft).Column
Range(Cells(k, 1), Cells(k + Val(Rng), n)).FillDown


End If
Next
End Sub

感谢大家对此的帮助！