1

我正在使用 SHEETOFFSET VBA 代码

Function SHEETOFFSET(offset, Ref)
' Returns cell contents at Ref, in sheet offset
Application.Volatile
With Application.Caller.Parent
SHEETOFFSET = .Parent.Sheets(.Index + offset) _
.Range(Ref.Address).Value
End With
End Function

然后是我的新工作表中的以下代码

=sheetoffset(-1, B2)

将上一张表中单元格 B2 的值复制到我的新表中。

但是，我还需要复制该特定单元格的颜色。我可以在上面的原始 VBA 代码中输入任何代码来执行此操作吗？还是有另一种方法可以实现这一目标？

非常感谢您的帮助蒂姆

4

1 回答 1

1

逻辑：

  1. 定义一个Public变量来保存单元格的颜色
  2. 检查上述Worksheet_Change变量是否有任何值。如果是，则更改目标单元格的颜色。
  3. 完成上述操作后，将变量重置为 0

模块中的代码：

Public cellColor As Double

Function SHEETOFFSET(offset, Ref)
    With Application.Caller.Parent
        SHEETOFFSET = .Parent.Sheets(.Index + offset) _
        .Range(Ref.Address).Value

        '~~> Store the color in a variable
        cellColor = .Parent.Sheets(.Index + offset) _
        .Range(Ref.Address).Interior.ColorIndex
    End With
End Function

工作表代码区域中的代码：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim aCell As Range

    On Error GoTo Whoa

    Application.EnableEvents = False

    For Each aCell In Target.Cells
        If cellColor <> 0 Then aCell.Interior.ColorIndex = cellColor
    Next

Letscontinue:
    cellColor = 0
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue
End Sub

截图：

在此处输入图像描述

我的个人想法：

  1. 我首先不赞成该SHEETOFFSET函数，因为该公式实际上是指当前工作表中的一个单元格。任何更改（例如，删除该单元格）都会使您的公式出错
  2. 最好直接链接单元格

跟进（来自评论）

您可以在最后运行此代码以刷新所有公式。

Sub Sample()
    Dim ws As Worksheet
    Dim rng As Range, aCell As Range

    For Each ws In ThisWorkbook.Sheets
        Set rng = Nothing

        On Error Resume Next
        Set rng = ws.Cells.SpecialCells(xlCellTypeFormulas)
        On Error GoTo 0

        If Not rng Is Nothing Then
            For Each aCell In rng
                aCell.Formula = aCell.Formula
            Next
        End If
    Next
End Sub
于 2013-04-30T22:34:01.487 回答