从函数设置单元格值

Question

单元格A1 的内容是=test(2)，其中test 是函数：

Function test(ByRef x As Double) As Double
  Range("A2") = x
  test = x * x
End Function

你能解释为什么这会在单元格A1 中给出#VALUE! 而在单元格A2 中什么都没有？我预计A2 包含2 和A1 包含4。如果没有Range("A2") = x 行，函数将按预期工作（对单元格的值进行平方）。

真正令人困惑的是，如果您将 test 与子例程 calltest 包装起来，那么它会起作用：

Sub calltest()
  t = test(2)
  Range("A1") = t
End Sub

Function test(ByRef x As Double) As Double
  Range("A2") = x
  test = x * x
End Function

但这不是

Function test(ByRef x As Double) As Double
  Range("A2") = x
End Function

Answer 1

由于Function 基本原理规定您不能更改或设置工作表单元格。您需要删除带有Range("A2") = x的行

编辑一些额外的链接（我相信这对于那些想要分析 UDF 主题的人来说总是有用的）：Creating custom functions by Microsoft

Answer 2

当您从工作表单元格调用函数时，您实际上是将该函数用作用户定义函数，其限制如下所述：

http://support.microsoft.com/kb/170787

文中有一行：

任何环境变化都应该通过使用视觉来进行 基本子程序。

有趣的是他们如何使用应该这个词而不是必须。我想知道知识库的作者是否知道环境更改可以通过 VBA 函数发生。

现在，当您从另一个 VBA 子/函数调用该函数时，它的处理方式将有所不同。从帮助文档中（抱歉，我找不到网页参考 - 基本上，在 VBE 中，突出显示 Function 一词并按 F1）：

与 Sub 过程一样，Function 过程是一个单独的过程 可以接受参数，执行一系列语句，并改变 其参数的值。但是，与 Sub 过程不同，您可以 在表达式右侧使用 Function 过程 使用任何内在函数（例如 Sqr、Cos 或 Chr）的方式相同， 当你想使用函数返回的值时。

所以听起来 Subs 和函数仅在 VBA 中使用时可以做同样的事情，除了 Functions 可以将值返回给调用函数/sub。

实际上，这很有趣，因为 Excel 可以调用对 Excel 环境具有某种“只读”限制的函数。

我认为，最后，Excel 可以以与 VBA 不同的方式从工作表单元格调用函数。当您从单元格中调用它时，它被认为是用户定义的函数，其中包括更改 Excel 环境的限制。当从 VBA 中调用时（其中原始调用者来自 VBA 调用链），它具有 Sub 的所有功能，并且可以返回值。

Answer 3

是的，您可以拥有自己的用户定义函数，该函数将值写入任何单元格，而不仅仅是您在公式中键入的那个。

这是一个简单的例子。 UDF 函数接受两个参数 A 和 B 并返回它们的乘积 A*B。但有趣的是，它在我们输入公式的单元格右侧的相邻单元格中返回结果。

将此代码放入标准 VBA 模块中：

Function UDF_RectangleArea(A As Integer, B As Integer)
    Dim MagicSpell As String
    MagicSpell = "Adjacent(" & Application.Caller.Offset(0, 1).Address(False, False) & "," & A & "," & B & ")"
    Evaluate MagicSpell
    UDF_RectangleArea = "Hello world"
End Function

Private Sub Adjacent(CellToChange As Range, A As Integer, B As Integer)
    CellToChange = A * B
End Sub

现在输入B2 公式：=UDF_RectangleArea(3,4)

该函数在两个单元格中返回结果：B2 中的“Hello world”（这并不奇怪）和C2 中的矩形区域（这是一只脱了帽子的兔子）。结果以及“兔子”外观的位置都可以轻松定制。该工作由 VBA EVALUALTE 命令完成。在这种情况下，变量MagicSpell 的值变为Adjacent(C2,3,4)，它在返回UDF 结果之前从UDF 中触发。玩得开心！

Answer 4

我已经调整了您的代码，使其适用于字符串和函数以及我希望的其他任何东西（仍在测试中）。

很多问题来自测试，但首先想到的是 2 个：

您可以使用哪些其他方式来执行/处理参数并返回所需的结果；

一个。正如我所做的那样 湾。不像我做的那样（即不同）。

非常感谢 Rick Rothstein MrExcel MVP 和 SO 上的许多其他人为实现这一目标提供支持和帮助。

Function MOVEME27(a As Variant, b As Variant, Optional CELLR As Variant, Optional cellq As Variant) '21/05/2018 works copied to ar4' 03/06/2019 23:30 was cellr as range , cellq as range - changed to variants
 Dim WTVR1 As Variant '' ''20/05/2019'' '09/06/2019 Code by S Tzortzis/David Wooley
 Dim WTVR2 As Variant
 Dim P As String
 Dim P1 As String
 Dim bb As String
 Dim bb1 As String
 Dim A1 As Long
 Dim A2 As Long

 Dim c As String

 'x' a = Evaluate(a)
P = Chr(34) & a & Chr(34)
P2 = Chr(34) & [P] & Chr(34)

bb = Chr(34) & b & Chr(34)
bb1 = Chr(34) & [bb] & Chr(34)

c = Chr(34) & CELLR & Chr(34)
f = Chr(34) & callq & Chr(34)


'P2 = Chr(34) & "'''" & [P] & "'''" & Chr(34)
'p1 = Chr(34) & p & Chr(34)

''WTVR1 = "MOVEUS1(" & Application.Caller.Offset(0, 2).Address(False, False) & "," & Chr(34) & P2 & Chr(34) & "," & b & ")"
   WTVR1 = "MOVEUS11h(" & Application.Caller.Offset(0, 2).Address(False, False) & "," & [P2] & "," & [bb1] & ")"
Evaluate WTVR1


WTVR2 = "MOVEUS22h(" & Application.Caller.Offset(0, 1).Address(False, False) & "," & [P2] & "," & [bb1] & ")" ' used or be adjacent - maybe redo rhat pr put a GO TO sub. '' ''20/05/2019''

Evaluate WTVR2

A1 = cellq.Row
A2 = cellq.Column

CELLRR = Chr(34) & CELLR & Chr(34)
CELLRR1 = Chr(34) & [CELLRR] & Chr(34)
cellqq = Chr(34) & cellq & Chr(34)
cellqq1 = Chr(34) & [cellqq] & Chr(34)


''wtvr3 = "CopyFrom.Parent.Evaluate CopyOver234h(" & c & "," & f & ")" ''''20190531 1929
wtvr31 = "MOVEUS33h(" & Application.Caller.Offset(A1 - ActiveCell.Row + 1, A2 - ActiveCell.Column).Address(False, False) & "," & [CELLRR] & "," & [cellqq] & ")"

    Evaluate wtvr31

MOVEME27 = "Hello world       " & " / " & WTVR1 & " / " & WTVR2 & "\\\\\/////" & wtvr31 & "\\\\\/////---" & ActiveCell.Row - A1 & "//////---" & ActiveCell.Column - A2

' DO AS WHATVER = "MOVEUS3(" APPLICATION.CALLER.OFFSET(THE ROW & COLUMN IE CELL         YOU REFERENCES IN a as variant (copy from)'
    'with ="" in sub 30052019 19:28

    'CopyFrom.Parent.Evaluate "CopyOver2(" & CELLR.Address(False, 1) & "," &              CELLR.Address(False, False) & ")"  ''''2019050 1929



    End Function

    Private Sub MOVEUS11h(CELL1 As Range, G1 As Variant, G2 As Variant)

        '[ak333] = a


        CELL1 = Chr(34) & G1 & Chr(34) & "B" & "//" & G2


    End Sub


    Private Sub MOVEUS22h(CELL2 As Range, G3 As Variant, G4 As Variant)

        CELL2 = Chr(34) & G3 & Chr(34) & "<>" & G4

    End Sub

    '' with chr(34) arond the p's and a's in sub or fucntion changes behavior. thinking of doing if a is string, then a=x , x as string, if not kep as variant
    ''27/05/2019 :(

    '''''30/05/2019 .....'''''''


    '------------------------------------------------------------------------------- ADD THIS 30052019 -------------------------------
    'private sub Movus3(cellfrom as range, cellto as range)
    'End Sub

    Private Sub moveus33h(cell3 As Range, CopyFrom As Variant, copyTo As Variant) ''''2019050 1929 ''' 03062019 change ema back to as Range here. :)
       '' copyTo.Value = CopyFrom.Value ''''2019050 1929

       ''CopyFrom.Value = ""

       cell3 =  CopyFrom  'Chr(34) & CopyFrom & Chr(34)

    End Sub ''''2019050 1929