Excel VBA-在下面插入一行,复制公式和格式,并在选定列中插入特定的默认数据



我在Excel中有一个相当大的数据库。大约一半的列数据是手工输入的。一个问题困扰了我一段时间。我用手插入行。我亲手抄公式。非常容易出错。我手动设置格式。这张纸相当复杂。

我试着自动化这个过程,可惜总是有一些错误。

Sub InsertRow()
ActiveCell.Offset(1).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrAbove
ActiveCell.EntireRow.Copy
ActiveCell.Offset(1).EntireRow.PasteSpecial xlPasteFormats
ActiveCell.Offset(1).EntireRow.PasteSpecial xlPasteFormulas
Application.CutCopyMode = False
End Sub

这似乎并没有照搬公式。我该如何在特定的列中放置默认值?

感谢所有的帮助。

以下是您的问题的解决方案。将代码安装到要插入行的工作表的代码模块中。它是工作簿中预先存在的模块之一,以选项卡命名。如果希望在多个工作表上执行相同的操作,请在每个适用的代码模块中安装该过程的版本。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Const TriggerClm    As String = "A"     ' change to suit
Const FirstDataRow  As Long = 2         ' change to suit
Dim Rng             As Range

Set Rng = Cells(Rows.Count, TriggerClm).End(xlUp).Offset(1)
With Target
If (.Address = Rng.Address) And (.Row > FirstDataRow) Then
Rows(.Row - 1).Copy             ' copies from last used row
'            Rows(FirstDataRow).Copy         ' copies from FirstDataRow
Rows(.Row).Insert Shift:=xlDown
On Error Resume Next
Rows(.Row - 1).SpecialCells(xlCellTypeConstants).ClearContents
Application.CutCopyMode = False
Cancel = True
End If
End With
End Sub

这就是将会发生的事情。当您双击一个单元格时,代码模块会捕获,并且上面的过程会对该操作做出响应。如果双击是在A列(TriggerClm(中最后一个使用的单元格下方的空白单元格上,则会在该点插入一个空行。它将包含从上面的行或工作表中的第一行(FirstDataRow(复制的所有格式和公式。

这也定义了所需的设置。您可以指定一个TriggerClm;A";以及除2之外的FirstDataRow。并且您必须在要从中复制的两个源之间进行选择,禁用您不想使用的源。请阅读代码中的备注。

经过多年的动摇,我现在在大多数项目中都倾向于最后一次使用一路领先而不是第一次。如果需要的话,我通常还会添加代码来插入日期,通常是在TriggerClm中。

您可能熟悉双击切换到单元格内编辑的原始功能。插入行时,此功能将被取消。但是,如果去掉Cancel = True,则代码将在新单元格中的编辑模式下停止。

如果您想将其保留为模块中的宏,下面是代码。并不是说当excel复制";公式";它还复制值。我还添加了一个留置权,向您展示如何将第3列更改为第5列

Sub InsertRow()
Dim CurRow As Range
Dim NewRow As Range
ActiveCell.EntireRow.Insert
Set CurRow = ActiveCell.EntireRow.Offset(1)
Set NewRow = ActiveCell.EntireRow
CurRow.Copy
NewRow.PasteSpecial Paste:=xlPasteFormulas
NewRow.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
NewRow.Columns(3) = 5
End Sub

最新更新