我在 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 公式一样 - 按 Enter 键后,该函数必须返回 vlookupnew 结果及其单元格格式
不要复制/粘贴单元格的格式。有什么建议吗?
我的目标的打印屏幕 Printscreen of excel
最佳答案
好吧,我们不能对人力资源总监说我们不能,不是吗? :P 尽管在自定义用户定义函数 (UDF) 中进行复制/粘贴等某些操作并不简单,但它仍然可以通过一种棘手的方式来实现,在某种程度上,有一些限制,我将在最后指出。
下面的代码片段可以被视为实现任何类型“禁止的 UDF 操作”
的通用技术:以某种方式记住它们并让 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 - VBA 用户定义函数中复制/粘贴特殊单元格格式,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/33921752/