Excel VBA - 在特定文本和复制格式和公式之上插入行 [英] Excel VBA - Insert row above specific text and copy formats and formula

问题描述

我看到我有类似的问题，但是我无法找到包含我的两个查询的VBA。我对VBA来说是相当新鲜的，因此我们努力将两个代码组合成一个单一的代码：

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

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

  Sub insertRow（）
 
 Dim Rng，n As Long，k As Long 
 Application.ScreenUpdating = False 
 Rng = InputBox（输入所需行数）
如果Rng =然后退出Sub 
范围（ActiveCell，ActiveCell.Offset（Val（Rng ） -  1，0））。EntireRow.Insert 
'需要知道要复制多少公式。 
'假设从A到最后输入行。 
k = ActiveCell.Offset（-1，0）.Row 
n = Cells（k，256）.End（xlToLeft）.Column 
范围（Cells（k，1），Cells + Val（Rng），n））。FillDown 
 
 End Sub 
  

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

  Sub insertRow（）
 
 Dim c As Range 
对于每个c In Range（A：A）
如果c.Value像* TTDASHINSERTROW *那么
 c.Offset（1，0） .EntireRow.Insert 
 End If 
下一个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 
如果Cells（i，1）.Value LikeTTDASHINSERTROW然后
 
 Dim Rng，n As Long，k As Long 
 Application.ScreenUpdating = False 
 Rng = InputBox 输入所需行数）
如果Rng =然后退出Sub 
 
范围（ActiveCell，ActiveCell.Offset（Val（Rng） -  1，0））EntireRow。插入
'需要知道要复制多少公式。 
'假设从A到最后输入行。 
 
k = ActiveCell.Offset（-1,0）.Row 
n = Cells（k，256）.End（xlToLeft）.Column 
范围（单元格（k，1） ，细胞（k + Val（Rng），n））。FillDown 
 
 
结束If 
下一个
 End Sub 
  

代替参与活动单元格的代码的第二部分，它可能用TTDASHINSERTROW找到单元格，并复制公式，

不幸的是我没有足够的代表来附加屏幕截图。

解决方案

解决

所有我需要使用我的代码包括一个查找功能，该单元格包含TTDASHINSERTROW，因此使该单元格成为活动单元格。

  Sub InsertRow（）
 
 
 Cells.Find（什么：=TTDASHINSERTROW，之后：= ActiveCell，LookIn：= xlValues，_ 
 LookAt：= xlPart，SearchOrder：= xlByColumns，SearchDirection：= xlNext，_ 
 MatchCase：= False，SearchFormat：= False）。激活
 
 Dim d As Integer 
d = Range（A：A）。End（xlDown）.Row 
 Dim c As Range 
 For i = d To 1步骤-1 
如果单元格（i，1）.Value像TTDASHINSERTROW然后
 
 Dim Rng，n As Long，k As Long 
 Application.ScreenUpdating = False 
 Rng = InputBox（输入需要的行数）
如果Rng =然后退出Sub 
 
范围（ActiveCell，ActiveCell.Offset（Val（Rng） ，0））。EntireRow.Insert 
'需要知道要复制多少公式。 
'假设从A到最后输入行。 
 
k = ActiveCell.Offset（-1,0）.Row 
n = Cells（k，256）.End（xlToLeft）.Column 
范围（单元格（k，1） ，细胞（k + Val（Rng），n））。FillDown 
 
 
结束If 
下一个
 End Sub 
  

感谢大家的帮助！

I see there are similar questions to mine however I am unable to find a VBA which includes both of my queries. I am fairly new to VBA and am therefore struggling to combine two codes into a single code which:

Inserts a specified number of rows above a row containing the text "TTDASHINSERTROW" and copies formats and formula from the above row.

The first code I have inserts a number of rows and copies the formula from above but is based on an "Active Cell".

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

The second code inserts one row based on a search for the text "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

Any help in combining these into a single code which can insert a specified number of rows above the specified text and copies the formats and formula will be appreciated.

UPDATE

I have come up with the following code which allows the user to add a specified number of rows through a pop up window when running the macro. The code still requires an active cell and copies the formula from above that cell.

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

Instead of the second part of the code refering to the active cell is it possible for it to find the cell with "TTDASHINSERTROW" and copy the formula and formatting from above that row?

Unfortunately I don't have enough rep to attach a screenshot.

解决方案

Solved.

All I needed to do with my code is include a "find" function which located the cell containing "TTDASHINSERTROW", therefore making that cell the active cell.

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

Thanks to everyone for the help on this!

这篇关于Excel VBA - 在特定文本和复制格式和公式之上插入行的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！