Excel VBA – 在特定文本和复制格式和公式之上插入行

我看到有类似的问题，但我无法find一个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 

第二个代码基于search文本“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 

任何帮助将这些组合成一个代码，可以在指定的文本上面插入指定数量的行并复制格式和公式。

UPDATE

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

 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 

而不是引用到活动单元格的代码的第二部分是否有可能find具有“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 

感谢大家的帮助！