Question

我在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

Answer 1

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

以下代码段可以被视为实现任何类型的"forbidden UDF operations"的一般技术：以某种方式记住它们并让Workbook_SheetCalculate事件处理程序稍后执行它们。

我的想法是依靠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。

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

1 个答案: