修改代码以在创建新行时在隐藏的单元格中复制公式

Question

我正在使用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

Answer 1

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：...，但最后一行被过滤器隐藏

在这种情况下，上述两种代码变体都将找到最后一个可见行，然后通过覆盖其内容将其复制到其下一个（隐藏）行中-当然是不需要的！

如果通过以下代码更改中间部分，则在最后一个“二手”行下方绝对没有任何内容的情况下，它会起作用。 （有关UsedRange的问题，请参见Error in finding last used cell in VBA）

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

由于合并后的单元格的边框（也许还有其他格式）可能与上面的行有所不同，因此您可以另外恢复它。