excel - 将最后两行复制/粘贴到下一个空行并清除某些单元格(包含合并的单元格)
问题描述
我正在尝试在工作表顶部制作一个命令按钮,按下该按钮时将复制 A:AJ 列中包含数据的最后 2 行并粘贴到它们下方的下一个空行中。我希望复制源样式和公式,而不是手动输入的数据。我这里也有一张图片可以帮助您:
例如,从图像中。我想将第 105/106 行复制在一起,然后将它们粘贴到 107/108,因为它们是下一个空行(虽然隐藏,所以也需要取消隐藏这些行)。除了底部的“笔画”部分和par/strokes框是我想要复制的公式/日期/数据验证/下拉列表之外,这两行中的所有内容都应该复制,但笔画部分为空,日期/下拉列表也为空. 我希望它看起来都一样(复制样式)。在这种情况下要清除的填充单元格将是 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
这可能是完全错误的,但它确实有效。
解决方案
为了实现您尝试使用 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 并进行一些错误处理(我没有在这里包含)。
推荐阅读
- java - 如何最大化加载场景中的 FXML?
- hive - Oozie 处理敏感参数(秘密)
- php - 用一个 PHP 在 MySQL 中插入多条记录
- javascript - 如何使用javascript从解析平台检索具有键和值的for循环中的行
- python - 多次创建新的 TensorFlow 设备
- unix - PCB和PDB之间的区别或相似之处
- python - 如果其他 col 具有相同的值,则减去两个 df col
- elisp - Emacs Lisp 中的尾递归展平函数
- batch-file - 重命名日期格式的文件
- php - Google PHP SDK 未更改 setAccessToken 上的 Accesstoken