我不希望我的 Excel 加载项返回一个数组（相反，我需要一个 UDF 来更改其他单元格）

Question

我创建了一个 Excel New_Years ，这个New_Years的功能之一，假设New_Years目前需要 2 年，并在这 2 年之间的每个New_Years输出作为 Excel 中的数组。 因此New_Years(2000,2002)将在最后一个单元格中返回 2000 年 1 月 1 日、2001 年 1 月 1 日和 2002 年 1 月 1 日。

问题是我必须知道那个时间会有 3 个日期，选择 3 个单元格，在顶部单元格中输入我的公式，然后Ctrl + Shift + Enter来填写数组。

我使用 XLW 版本 5 将我的 C++ 代码转换为 .xll 文件。 如果有某种方法我可以用我的公式填充一个正方形，我真的很喜欢它，Excel 会根据需要用适当的日期填充下面的正方形。 有谁知道这是否可能？ 还是不可能？

非常感谢！

Answer 1

尽管很复杂，但实际上是可能的。 我正在重新发布Kevin Jones aka Zorvek 的这块魔法，因为它位于EE Paywall 后面（如果有人可以访问，请附上链接）

尽管 Excel 严格禁止 UDF 更改任何单元格、工作表或工作簿属性，但当使用 Windows 计时器和 Application.OnTime 计时器依次调用 UDF 时，有一种方法可以实现此类更改。 Windows 计时器必须在 UDF 中使用，因为 Excel 会忽略 UDF 中的任何 Application.OnTime 调用。 但是，由于 Windows 计时器有限制（如果 Windows 计时器在编辑单元格或打开对话框时尝试运行 VBA 代码，Excel 将立即退出），因此它仅用于安排 Application.OnTime 计时器，这是一个安全计时器Excel 仅允许在未编辑单元格且未打开任何对话框时触发。

下面的示例代码说明了如何从 UDF 内部启动 Windows 计时器，如何使用该计时器例程来启动 Application.OnTime 计时器，以及如何将只有 UDF 知道的信息传递给后续的计时器执行例程。 下面的代码必须放在常规模块中。

Private Declare Function SetTimer Lib "user32" ( _
      ByVal HWnd As Long, _
      ByVal nIDEvent As Long, _
      ByVal uElapse As Long, _
      ByVal lpTimerFunc As Long _
   ) As Long

Private Declare Function KillTimer Lib "user32" ( _
      ByVal HWnd As Long, _
      ByVal nIDEvent As Long _
   ) As Long

Private mCalculatedCells As Collection
Private mWindowsTimerID As Long
Private mApplicationTimerTime As Date

Public Function AddTwoNumbers( _
      ByVal Value1 As Double, _
      ByVal Value2 As Double _
   ) As Double

' This is a UDF that returns the sum of two numbers and starts a windows timer
' that starts a second Appliction.OnTime timer that performs activities not
' allowed in a UDF. Do not make this UDF volatile, pass any volatile functions
' to it, or pass any cells containing volatile formulas/functions or
' uncontrolled looping will start.

   AddTwoNumbers = Value1 + Value2

   ' Cache the caller's reference so it can be dealt with in a non-UDF routine
   If mCalculatedCells Is Nothing Then Set mCalculatedCells = New Collection
   On Error Resume Next
   mCalculatedCells.Add Application.Caller, Application.Caller.Address
   On Error GoTo 0

   ' Setting/resetting the timer should be the last action taken in the UDF
   If mWindowsTimerID <> 0 Then KillTimer 0&, mWindowsTimerID
   mWindowsTimerID = SetTimer(0&, 0&, 1, AddressOf AfterUDFRoutine1)

End Function

Public Sub AfterUDFRoutine1()

' This is the first of two timer routines. This one is called by the Windows
' timer. Since a Windows timer cannot run code if a cell is being edited or a
' dialog is open this routine schedules a second safe timer using
' Application.OnTime which is ignored in a UDF.

   ' Stop the Windows timer
   On Error Resume Next
   KillTimer 0&, mWindowsTimerID
   On Error GoTo 0
   mWindowsTimerID = 0

   ' Cancel any previous OnTime timers
   If mApplicationTimerTime <> 0 Then
      On Error Resume Next
      Application.OnTime mApplicationTimerTime, "AfterUDFRoutine2", , False
      On Error GoTo 0
   End If

   ' Schedule timer
   mApplicationTimerTime = Now
   Application.OnTime mApplicationTimerTime, "AfterUDFRoutine2"

End Sub

Public Sub AfterUDFRoutine2()

' This is the second of two timer routines. Because this timer routine is
' triggered by Application.OnTime it is safe, i.e., Excel will not allow the
' timer to fire unless the environment is safe (no open model dialogs or cell
' being edited).

   Dim Cell As Range

   ' Do tasks not allowed in a UDF...
   Application.ScreenUpdating = False
   Application.Calculation = xlCalculationManual
   Do While mCalculatedCells.Count > 0
      Set Cell = mCalculatedCells(1)
      mCalculatedCells.Remove 1
      Cell.Offset(0, 1).Value = Cell.Value
   Loop
   Application.Calculation = xlCalculationAutomatic
   Application.ScreenUpdating = True
   End Sub

Answer 2

多亏了本页较早的帖子，我能够创建一种易于使用的模块。

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' POST UDF UPDATING MODULE                                   v.9.2020 cdf
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' Since Excel won't allow UDFs to update any other cells,
'   an API timer is used to trigger a post UDF subroutine.
'
' This acts like a recalculate.  Your code should recalculate the entire
'   sheet.  Tried to get it to work with a specific range, but, with all
'   the different update variations ({Enter}, {Tab}, {Backspace}, {Delete},
'   mouse click in the middle of an update, etc.), no luck. Any ideas?
'
' Originally, before the slight tweak, the code was found here:
'   https://stackoverflow.com/questions/8520732/
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'                             HOW TO USE
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' Create a module (in the Modules folder) and copy this entire document 
'   into it.
'
'
' Code this code into your UDF's subroutine in your module (in Modules
'   folder) (should be close to the end of the code):
'
'     ' Use Post UDF Timer to update other cells.
'     Call TimerModulesName.SetAPITimer("UDFModule.PostUDFRoutine")
'
'
' Edit the code names:
'
'     Change TimerModulesName to the module you copied this document into.
'            UDFModule        to the module your post UDF subroutine is in.
'            PostUDFRoutine   to your post UDF subroutine.
'
'     Example: Module4.SetAPITimer("Module1.UpdateMyCells")
'
'

#If VBA7 Then

Private Declare PtrSafe Function SetTimer Lib "user32" ( _
      ByVal hwnd As Long, _
      ByVal nIDEvent As Long, _
      ByVal uElapse As Long, _
      ByVal lpTimerFunc As LongLong _
   ) As Long

Private Declare PtrSafe Function KillTimer Lib "user32" ( _
      ByVal hwnd As Long, _
      ByVal nIDEvent As Long _
   ) As Long
   
#Else

Private Declare Function SetTimer Lib "user32" ( _
      ByVal HWnd As Long, _
      ByVal nIDEvent As Long, _
      ByVal uElapse As Long, _
      ByVal lpTimerFunc As Long _
   ) As Long

Private Declare Function KillTimer Lib "user32" ( _
      ByVal HWnd As Long, _
      ByVal nIDEvent As Long _
   ) As Long
   
#End If

Private mCalculatedCells As Collection
Private mWindowsTimerID As Long
Private mApplicationTimerTime As Date
Private mRoutine As String

Public Sub SetAPITimer(sRoutine As String)
    
' Starts a windows timer that starts a second Appliction.OnTime
' timer that performs activities not allowed in a UDF. Do
' not make this UDF volatile, pass any volatile functions
' to it, or pass any cells containing volatile
' formulas/functions or uncontrolled looping will start.

    ' Cache the caller's reference so it can be dealt with in a non-UDF routine
    If mCalculatedCells Is Nothing Then Set mCalculatedCells = New Collection
    On Error Resume Next
    mCalculatedCells.Add Application.Caller, Application.Caller.Address
    On Error GoTo 0

    ' Setting/resetting the timer should be the last action taken in the UDF
    If mWindowsTimerID  0 Then KillTimer 0&, mWindowsTimerID
    mWindowsTimerID = SetTimer(0&, 0&, 1, AddressOf AfterUDFRoutine1)

    ' Set Post UDF module and routine
    mRoutine = sRoutine
End Sub

Private Sub AfterUDFRoutine1()

' This is the first of two timer routines. This one is called by the Windows
' timer. Since a Windows timer cannot run code if a cell is being edited or a
' dialog is open this routine schedules a second safe timer using
' Application.OnTime which is ignored in a UDF.

   ' Stop the Windows timer
   On Error Resume Next
   KillTimer 0&, mWindowsTimerID
   On Error GoTo 0
   mWindowsTimerID = 0

   ' Cancel any previous OnTime timers
   If mApplicationTimerTime  0 Then
      On Error Resume Next
      Application.OnTime mApplicationTimerTime, "AfterUDFRoutine2", , False
      On Error GoTo 0
   End If

   ' Schedule timer
   mApplicationTimerTime = Now
   Application.OnTime mApplicationTimerTime, "AfterUDFRoutine2"
End Sub

Private Sub AfterUDFRoutine2()

' This is the second of two timer routines. Because this timer routine is
' triggered by Application.OnTime it is safe, i.e., Excel will not allow the
' timer to fire unless the environment is safe (no open model dialogs or cell
' being edited).

    ' Do tasks not allowed in a UDF... (post UDF code)
    Application.Run mRoutine
End Sub