Question

我正在尝试在工作表顶部创建一个命令按钮，当按下该按钮时，它将复制A：AJ列中有数据的最后两行，并将其粘贴到其下方的下一个空行中。我希望复制源样式和公式，而不要复制手动输入的数据。我在这里也有图片可以提供帮助：

例如，从图像中。我想将行105/106复制到一起，然后将它们粘贴到107/108，因为它们是下一个空行（尽管已隐藏，所以也需要取消隐藏这些行）。除了底部的“笔画”部分和“ par /笔画”框是要复制的公式/日期/数据验证/下拉菜单外，这2行中的所有内容均应复制，但笔画部分为空以及日期/下拉菜单也为空白。我也希望它们看起来都一样（复制样式）。在这种情况下要清除的已填充单元格为B，C，E：M，P：X列，但仅在“ STROKES”行上。

从根本上讲。我想要按下一个按钮，这将向表中添加另一行。因此，在您可以看到的图片中我有52个，按下时我现在将在其下方有53个，并且空白可以使用。

如果需要取消隐藏行的工作，我可以这样做。

我一直想尝试自己做，但是我以前从未对VBA做过任何事情，因此我一无所知。我希望有人能理解这个要求，甚至是可行的。谢谢。

根据DecimalTurn的回答，我进行了一些更改，这是我的新代码：

Private Sub CommandButton1_Click()

'Find the last row based on column D (4th)
Dim LastRow As Long
LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 4).End(xlUp).Row

'Copy the range
ActiveSheet.Range("A" & (LastRow - 1) & ":" & "AJ" & LastRow).Copy
ActiveSheet.Range("A" & (LastRow + 1) & ":" & "AJ" & LastRow + 2).PasteSpecial
Application.CutCopyMode = False 'This will clear the clipboard

'Adjust numbering
ActiveSheet.Range("A" & LastRow + 1).Value2 = ActiveSheet.Range("A" & LastRow - 1).Value2 + 1

'Clear content
Dim ListOfColumnsToClear1() As Variant
Dim ListOfColumnsToClear2() As Variant
ListOfColumnsToClear1 = Array("B:C")
ListOfColumnsToClear2 = Array("E:M", "P:X")

Dim i As Long
For i = LBound(ListOfColumnsToClear1) To UBound(ListOfColumnsToClear1)

    Intersect(ActiveSheet.Range("A" & (LastRow + 1) & ":" & "AJ" & LastRow + 2), ActiveSheet.Range(ListOfColumnsToClear1(i))).ClearContents

Next i
For i = LBound(ListOfColumnsToClear2) To UBound(ListOfColumnsToClear2)


    Intersect(ActiveSheet.Range("A" & (LastRow + 2) & ":" & "AJ" & LastRow + 2), ActiveSheet.Range(ListOfColumnsToClear2(i))).ClearContents

    Next i

End Sub

这可能是完全错误的，但确实有效。

Answer 1

要实现您要使用VBA进行的操作，我建议您的代码按以下顺序执行以下操作：

找到最后一行数据。
定义范围以复制并复制该范围。
调整行号
清除需要手动输入的单元格的内容。

假设您不需要取消隐藏任何行，代码将如下所示：

Sub CopyLastTwoRows()

    'Find the last row based on column D (4th)
    Dim LastRow As Long
    LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 4).End(xlUp).Row

    'Copy the range
    ActiveSheet.Range("A" & (LastRow - 1) & ":" & "AJ" & LastRow).Copy
    ActiveSheet.Range("A" & (LastRow + 1) & ":" & "AJ" & LastRow + 2).PasteSpecial
    Application.CutCopyMode = False 'This will clear the clipboard

    'Adjust numbering
    ActiveSheet.Range("A" & LastRow + 1).Value2 = ActiveSheet.Range("A" & LastRow - 1).Value2 + 1

    'Clear content
    Dim ListOfColumnsToClear() As Variant
    ListOfColumnsToClear = Array("B:C", "E:M", "P:X")

    Dim i As Long
    For i = LBound(ListOfColumnsToClear) To UBound(ListOfColumnsToClear)

        Intersect(ActiveSheet.Range("A" & (LastRow + 2) & ":" & "AJ" & LastRow + 2), ActiveSheet.Range(ListOfColumnsToClear(i))).ClearContents

    Next i

End Sub

现在，由于您已经合并了单元格，因此我们清除数据的部分会给您一个错误，因为只有合并的单元格的底部会相交。为了解决这个问题，我们可以使用一个函数来确保如果我们的范围内有合并的单元格，那么将包含所有单元格。

代码如下所示（请注意最后的新功能）：

Sub CopyLastTwoRows()

    'Find the last row based on column D (4th)
    Dim LastRow As Long
    LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 4).End(xlUp).Row

    'Copy the range
    ActiveSheet.Range("A" & (LastRow - 1) & ":" & "AJ" & LastRow).Copy
    ActiveSheet.Range("A" & (LastRow + 1) & ":" & "AJ" & LastRow + 2).PasteSpecial
    Application.CutCopyMode = False 'This will clear the clipboard

    'Adjust numbering
    ActiveSheet.Range("A" & LastRow + 1).Value2 = ActiveSheet.Range("A" & LastRow - 1).Value2 + 1

    'Clear content
    Dim ListOfColumnsToClear() As Variant
    ListOfColumnsToClear = Array("B:C", "E:M", "P:X")

    Dim i As Long
    For i = LBound(ListOfColumnsToClear) To UBound(ListOfColumnsToClear)

        ExpandToIncludeMergedCells(Intersect(ActiveSheet.Range("A" & (LastRow + 2) & ":" & "AJ" & LastRow + 2), ActiveSheet.Range(ListOfColumnsToClear(i)))).ClearContents

    Next i

End Sub

Private Function ExpandToIncludeMergedCells(ByRef Rng As Range) As Range

    Dim TempRange As Range
    Set TempRange = Rng.Cells(1)

    Dim c As Range
    For Each c In Rng

        Set TempRange = Union(TempRange, c.MergeArea)

    Next c

    Set ExpandToIncludeMergedCells = TempRange

End Function

最后，如果您想通过按一个按钮多次（例如10次）来执行此操作，则只需执行以下操作：

Private Sub CommandButton1_Click()

    Application.ScreenUpdating = False

    Dim i As Long
    For i = 1 To 10
        CopyLastTwoRows
    Next i

    Application.ScreenUpdating = True

End Sub

请注意，我正在使用Application.ScreenUpdating = False告诉Excel在宏运行时不要刷新屏幕。这将使您的代码运行得更快，但是建议最后将其设置为true并使用一些error handling（我在此处未包括）。

将最后两行复制/粘贴到下一个空行中，并清除某些单元格（包含合并的单元格）

1 个答案: