VBA用户定义函数中的复制/过去特殊单元格格式

Posted 2023-04-13

【中文标题】VBA用户定义函数中的复制/过去特殊单元格格式

【英文标题】：copy/pastspecial cell format in VBA User-Defined Function

【发布时间】：2015-11-25 16:33:58

【问题描述】：

我在 VBA 中有一个公式： - 执行 VLOOKUP - 查找具有 vlookup 找到的值的单元格的地址 - 问题：复制/粘贴特殊原始单元格的格式 - vlookup 的返回值

Function VLOOKUPnew(ValueToLook As Range, Interval As Range, ColIndex As Integer) As Variant

Dim fMatch, fVlookup

Dim ColMatchIndex
Dim CellOrigin, CellDestination

' ********************************************************************************
' LOOKUP:: Application.VLookup(ValueToLook, Interval, colIndex, False)
' MATCH:: Application.Match(ValueToLook, Range(Interval.Address()).Columns(1), 0)
' ********************************************************************************

' Indice da 1ª coluna do Intervalo
' **********************************************
ColMatchIndex = Interval.Columns(Interval.Columns.Count - 1).Column
' **********************************************

fMatch = Application.Match(ValueToLook, Range(Interval.Address()).Columns(1), 0)

' Obtem o endereço da célula que contem o valor do VLOOKUP
' **********************************************
CellOrigin = Interval.Cells(fMatch, Interval.Columns.Count).Address()
' **********************************************

' Copia a Formatação da Célula encontrada pelo Vlookup
' ******************************************************************
Range(CellOrigin).Copy
ActiveCell.PasteSpecial (xlPasteFormats)
Application.CutCopyMode = False
' ******************************************************************

VLOOKUPnew = Application.VLookup(ValueToLook, Interval, ColIndex, False)
End Function

需要牢记的一些提示： - 用户必须编写函数 - VLOOKUPnew - 就像他在 excel 中编写普通的 vlookup 公式一样 - 回车后，函数必须返回 vlookupnew 结果他的单元格格式

不要复制/粘贴单元格的格式。有什么建议吗？

我的目标的打印屏幕 Printscreen of excel

【问题讨论】：

不能复制粘贴到从单元格调用的函数中。

如何将单元格格式复制到另一个函数中？

你没有。函数返回值。为什么需要？

我需要执行 vlookup 并返回值和他的单元格的格式-

但是为什么需要复制格式呢？

【参考方案1】：

好吧，我们不能对人力资源总监说我们不能，可以吗？ :P 尽管在自定义的用户定义函数 (UDF) 中执行一些操作（例如复制/粘贴）并不简单，但它仍然可以通过一种棘手的方式实现，在某种程度上我将在最后指出一些限制。

后面的代码 sn-ps 可以被认为是实现任何类型的"forbidden UDF operations" 的通用技术：记住它们以某种方式并让Workbook_SheetCalculate 事件处理程序稍后执行它们。 p>

这个想法是依靠Workbook_SheetCalculate事件，因为我们知道它会在计算完成后被调用，而且不像UDF，它允许我们进行复制和粘贴。因此，UDF 将通过一些变量简单地将范围（源和目标）传递给它。一旦计算完成并完成 UDF，Workbook_SheetCalculate 将被自动调用；它将读取这些变量并完成 UDF 不允许直接允许的工作。

1) 在代码模块ThisWorkbook中：

Public Sources As New Collection, Destinations As New Collection

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
    Application.ScreenUpdating = False
    On Error GoTo Cleanup
    For Each src In Sources
        src.copy
        Destinations(1).PasteSpecial xlPasteFormats
        Destinations.Remove 1
    Next

Cleanup:
    Application.CutCopyMode = False
    Set Sources = New Collection: Set Destinations = New Collection
    Application.ScreenUpdating = True
End Sub

2) 在用户定义函数中，不要直接进行复制/粘贴操作，而是将源单元格和目标单元格分别添加到 ThisWorkbook.Sources 和 ThisWorkbook.Destinations 集合中。也就是说，替换您的 UDF 代码的以下部分：

Range(CellOrigin).Copy
ActiveCell.PasteSpecial (xlPasteFormats)
Application.CutCopyMode = False

用这个：

ThisWorkbook.Sources.Add Range(CellOrigin)
ThisWorkbook.Destinations.Add Application.ThisCell

这将实现所需的行为。但正如我所说，有一些限制：

首先，如果使用您的自定义 UDF 的单元格数量太大（比如数千个），这会有点慢。

其次，更重要的是，Excel 中的自动计算不会在您更改单元格的格式 时触发，而只有在您更改其值 时才会触发。因此，如果用户更改了源单元格的格式而不是其值，则格式不会立即在目的地报告。用户可能需要手动强制计算，即按F9。