gpt4 book ai didi

vba - VBA 用户定义函数中复制/粘贴特殊单元格格式

转载 作者:行者123 更新时间:2023-12-03 02:39:38 24 4
gpt4 key购买 nike

我在 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.SourcesThisWorkbook.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/

24 4 0
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com