VBA用户自定义功能中的复制/特殊格式 [英] copy/pastspecial cell format in VBA User-Defined Function

问题描述

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

 函数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（））。列（1），0）
'*************************** ************************************************** *** 
 
'Indice da1ªcoluna do Intervalo 
'*************************** ******************* 
 ColMatchIndex = Interval.Columns（Interval.Columns.Count  -  1）.Column 
'****** ***************** *********************** 
 
 fMatch = Application.Match（ValueToLook，Range（Interval.Address（））。列（ 1），0）
 
'Obtem oendereçodacélulaque contem o valor do VLOOKUP 
'******************** ************************** 
 CellOrigin = Interval.Cells（fMatch，Interval.Columns.Count）.Address（）
'********************************************** 
 
'Copia aFormataçãodaCélulaencontrada pelo Vlookup 
'***************************** ************************************* 
范围（CellOrigin）.Copy 
 ActiveCell.PasteSpecial（xlPasteFormats）
 Application.CutCopyMode = False 
'******************************* ************************************* $ 
 
 VLOOKUPnew = Application.VLookup （ValueToLook，Interval，ColIndex，False）
结束函数
  

：
- 用户必须写功能 - VLOOKUPnew - 就像他在excel中写正常的vlookup公式
- 按下Enter键后，必须返回vlookupnew结果他的单元格的格式

不要复制/粘贴单元格的格式。任何提示？

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

解决方案

嗯，我们不能说我们不能向人力资源总监，我们可以吗？ ：P
虽然在自定义用户定义函数（UDF）中进行一些操作（如复制/粘贴）并不直接，但仍然可以以棘手的方式实现，在某种程度上，我将会有一些限制指出结束。

下面的代码片段可以被认为是实现任何类型的禁止的UDF操作的一般技术 / code>：记住他们某种方式，让$ code> Workbook_SheetCalculate 事件处理程序稍后执行。

这个想法是指望 Workbook_SheetCalculate 事件，因为我们知道它将在计算完成后被调用，与UDF不同，它允许我们做复制和粘贴。因此，UDF将通过一些变量来简单地传递范围（来源和目的地）。一旦进行计算并完成了UDF，将自动调用 Workbook_SheetCalculate ;它将读取这些变量并实现UDF直接不允许的作业。

1）在代码模块 ThisWorkbook 中：

 公共源作为新集合，目的地作为新集合
 
 Private Sub Workbook_SheetCalculate（ByVal Sh As Object）
 Application.ScreenUpdating = False 
错误GoTo清理
对于每个src在源
 src.copy 
目标（1）.PasteSpecial xlPasteFormats 
 Destinations.Remove 1 
下一个
 
清理：
 Application.CutCopyMode = False 
 Set Sources = New Collection：Set Destinations = New Collection 
 Application.ScreenUpdating = True 
 End Sub 
  

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

  Range（CellOrigin）.Copy 
 ActiveCell.PasteSpecial（xlPasteFormats）
 Application.CutCopyMode = False 
  

这样：

  ThisWorkbook.Sources.Add范围（CellOrigin）
 ThisWorkbook.Destinations.Add Application.ThisCell 
  

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

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

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

I have a formula in VBA that: - Executes VLOOKUP - Find the address of the cell that has the value found by vlookup - PROBLEM: Copy/pastespecial original cell's format - Return Value of 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

Some tips to keep in mind: - User must write function - VLOOKUPnew - like he writes normal vlookup formula at excel - After press enter, the function must return vlookupnew results his cell's format

Don't copy/paste cell's format. Any tip?

Printscreen of my goal Printscreen of excel

解决方案

Well, we can't say we can't to the HR director, can we? :P Although it is not straightforward to do some operations such as copy/paste inside a custom User-Defined Function (UDF), it is still achievable in a tricky way, to some extent with a few limitations that I will point out at the end.

The code snippets that follow can be considered as a general technique to achieve any type of "forbidden UDF operations": memorize them somehow and let the Workbook_SheetCalculate event handler execute them later.

The idea is to count on the Workbook_SheetCalculate event, because we know that it will be invoked after the calculation is made, and unlike UDFs, it allows us to do copying and pasting. Therefore, the UDF will simply hand it the ranges (sources and destinations) through some variables. Once the calculation is made and the UDFs are finished, Workbook_SheetCalculate will be automatically invoked; it will read those variables and achieve the jobs that the UDF did not allow directly.

1) In code Module 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) In the User-Defined Function, instead of doing directly a copy/paste operation, add your source cell and your destination cell to the ThisWorkbook.Sources and ThisWorkbook.Destinations collections, respectively. That is, replace the following part of your UDF code:

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

with this:

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

This will achieve the desired behavior. But as I said, There are a few limitations:

First, it's a bit slow if the number of cells that use your custom UDF is too big (say thousands).

Second and more important, automatic calculation in Excel is not triggered when you change a cell's format, but only when you change its value. Therefore, if the user changes the source cell's format but not its value, the format will not be immediately reported at the destination. The user will probably need to manually force the calculation, i.e. by pressing F9.

这篇关于VBA用户自定义功能中的复制/特殊格式的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！