首页 > 解决方案 > 修改代码以在创建新行时复制隐藏单元格中的公式

问题描述

我正在使用 Excel 来跟踪为实验室程序返回的结果。有多个用户使用电子表格,我们为每个用户创建了自定义视图。当他们下载新记录时,他们使用下面的 VBA 脚本添加一行,效果很好,但有些单元格需要隐藏,其中包含公式,需要复制但不复制。

有什么我可以添加到这个脚本中以确保隐藏单元格中的公式也被复制吗?

Sub New_Delta()

  ' Go to last cell
  Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select

  ' Copy formula from cell above
  Rows(Selection.Row - 1).Copy
  Rows(Selection.Row).Insert Shift:=xlDown

End Sub

标签: excelvba

解决方案


A:复制最后一行...简单版

如果最后使用的行完全可见,并且第一列总是包含任何内容,我建议这样做:

Private Sub CopyLastRow()
    Dim r As Range
    Dim ws As Worksheet
    Set ws = ActiveSheet ' or whatever sheet

    ' following two line are referred as "middle part" later
    Set r = ws.Cells(ws.Rows.Count, 1).End(xlUp)
    r.EntireRow.Copy r.EntireRow.Offset(1, 0) ' copy content and format

    Set r = Nothing
    Set ws = Nothing
End Sub

如果最后使用的行在某处包含一些空单元格,最好通过(较慢)确定最后使用的行(Range.Find通过以下交换中间部分):

If WorksheetFunction.CountA(ws.Cells) > 0 Then
    Set r = ws.Cells.Find(What:="*", _
        LookIn:=xlFormulas, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious)
    r.EntireRow.Copy r.EntireRow.Offset(1, 0)
End If

B: ... 带有隐藏列

如果您只有一些“普通”隐藏列或隐藏的分组列,上述方法也有效。

C: ...但最后一行被过滤器隐藏

在这种情况下,上面的两个代码变体都会找到最后一个可见行并通过覆盖其内容将其复制到下一个(=隐藏)行 - 当然不需要!

如果您通过以下代码更改中间部分,则它可以工作,如果最后一个“使用”行下方绝对没有任何内容。(对于有关在 VBA 中查找最后使用的单元格时出现错误
担忧)UsedRange

Set r = ws.Cells(ws.UsedRange.Row + ws.UsedRange.Rows.Count - 1, 1)
r.EntireRow.Copy r.EntireRow.Offset(1, 0)

D: ...但是有过滤的行隐藏的列

如果您过滤了行并且另外有隐藏列,则会出现有关“多项选择”的错误消息,或者仅复制可见列并弄乱。我建议之前取消过滤。

E ...但有合并的单元格

水平合并的单元格将按原样复制。

但是,如果您有垂直(或垂直水平)合并的单元格,它们将被复制而不合并并且不包含任何内容,因为合并单元格的内容存储在左上角的单元格中(因此如果最后一行被复制,则不会被复制): 合并单元格的屏幕截图

在这种情况下,您可以复制行并合并单元格:

Set r = ws.Cells(ws.Rows.Count, 1).End(xlUp)
r.EntireRow.Copy r.EntireRow.Offset(1, 0) ' copy content and format

Dim c As Range
Dim CurrentColumn As Long
Dim MergedColumnCount As Long
For CurrentColumn = 1 To ws.UsedRange.Columns.Count
    Set c = ws.Cells(r.Row, CurrentColumn)
    If c.MergeArea.Rows.Count > 1 Then
        MergedColumnCount = c.MergeArea.Columns.Count
        c.MergeArea.Resize(c.MergeArea.Rows.Count + 1, c.MergeArea.Columns.Count).Merge
        CurrentColumn = CurrentColumn + MergedColumnCount - 1
    End If
Next CurrentColumn

重新合并单元格的屏幕截图

由于合并单元格的边框(可能还有其他格式)可能与上面的行不同,您可以另外恢复它。


推荐阅读