我看到有类似的问题,但是我无法找到包含我的两个查询的VBA。我对VBA相当新,因此我很难将两个代码组合成一个代码:
在包含文本" TTDASHINSERTROW"的行上方插入指定数量的行。并从上一行复制格式和公式。
我的第一个代码插入了多行,并从上面复制了公式,但是基于" 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
第二个代码根据搜索文本" 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"并从该行上方复制公式和格式?
不幸的是,我没有足够的代表来附上截图。
答案 0 :(得分:0)
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
答案 1 :(得分:0)
<强>解决。强>
我需要对我的代码执行的操作包括一个“查找”功能,该功能定位包含“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
感谢大家的帮助!