vba 从函数设置单元格值

声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow 原文地址: http://stackoverflow.com/questions/15659779/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me): StackOverFlow

提示:将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间:2020-09-08 15:16:28  来源:igfitidea点击:

Set a cell value from a function

excelvbaexcel-vba

提问by Chris Seymour

The contents of cell A1is =test(2)where testis the function:

单元格的内容A1=test(2)其中test的功能是:

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

Can you explain why this gives #VALUE!in cell A1and nothing in cell A2? I expected A2to contain 2and A1to contain 4. Without the line Range("A2") = xthe function works as expected (squaring the value of a cell).

你能解释为什么这#VALUE!在单元格中给出而在单元格中A1没有任何内容A2吗?我希望A2包含2A1包含4. 如果没有这条线Range("A2") = x,函数会按预期工作(对单元格的值进行平方)

What is really confusing is if you wrap testwith the subroutine calltestthen it works:

真正令人困惑的是,如果你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

But this doesn't

但这不

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

采纳答案by Joseph

When you call a function from a worksheet cell, you are effectively using the function as a User Defined Function, which has the limitations as described here:

当您从工作表单元格调用函数时,您可以有效地将该函数用作用户定义函数,其具有如下所述的限制:

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

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

In the text there is a line:

文中有一行:

Any environmental changes should be made through the use of a Visual Basic subroutine.

任何环境更改都应通过使用 Visual Basic 子例程进行。

It's interesting how they use the word shouldrather than must. I wonder if the author of the KB knew that environment changes can happen from a VBA Function.

有趣的是他们如何使用should而不是must这个词。我想知道 KB 的作者是否知道 VBA 函数可能会发生环境变化。

Now, when you call the function from another VBA Sub / Function, it is treated differently. From the help docs (sorry I couldn't find a web page reference - basically, in VBE, highlight the word Function and press F1):

现在,当您从另一个 VBA Sub/Function 调用该函数时,它会被区别对待。从帮助文档中(对不起,我找不到网页参考 - 基本上,在 VBE 中,突出显示函数一词并按 F1):

Like a Sub procedure, a Function procedure is a separate procedure that can take arguments, perform a series of statements, and change the values of its arguments. However, unlike a Sub procedure, you can use a Function procedure on the right side of an expression in the same way you use any intrinsic function, such as Sqr, Cos, or Chr, when you want to use the value returned by the function.

与 Sub 过程一样,Function 过程是一个单独的过程,它可以接受参数、执行一系列语句并更改其参数的值。但是,与 Sub 过程不同的是,当您想使用函数返回的值时,您可以像使用任何内部函数(例如 Sqr、Cos 或 Chr)一样,在表达式的右侧使用 Function 过程.

So it sounds like Subs and functions can do the same things when used in VBA only, except that Functions can return values back to the calling function/sub.

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

This is pretty interesting, actually, since Excel can call a function with some sort of "Read-Only" restriction to Excel's environment.

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

I think that, in the end, Excel can call the function from a worksheet cell in a different way than VBA does. When you call it from a Cell, it's considered a User Defined Function, which includes the restrictions of changing Excel's environment. Where when called from within VBA (where the originalcaller from a chain of calls is from VBA), it has all the power a Sub does, plus it can return values.

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

回答by Kazimierz Jawor

Due to Functionfundamentals which state that you can not change or set sheet cells. You need to delete the row with Range("A2") = x

由于Function基本原理表明您无法更改或设置工作表单元格。您需要删除行Range("A2") = x

EDITSome additional link (which I believe is always useful to provide for those who want to analyse UDF topic): Creating custom functions by Microsoft

编辑一些额外的链接(我认为对于那些想要分析 UDF 主题的人来说总是有用的):Creating custom functions by Microsoft

回答by Przemyslaw Remin

Yes, you can have your own user defined function which writes values to any cell, not just the one which you type in the formula.

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

Here is a simple example. The UDF function takes two arguments A and B and returns their product A*B. But what is interesting it returns the result in the adjacent cell just to the right of the cell in which we entered the formula.

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

Put this code in standard VBA module:

将此代码放入标准 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

Now type in B2the formula: =UDF_RectangleArea(3,4)

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

enter image description here

在此处输入图片说明

The function returns results in two cells: "Hello world" in B2(which is not surprising) and the rectangle area in C2(which is a rabbit out of a hat). Both results as well as the place of "rabbit" appearance can be easily customized. The job is done by the VBA EVALUALTEcommand. The value of variable MagicSpellbecomes in this case Adjacent(C2,3,4)which is fired from within the UDF before the UDF result is returned. Have fun!

该函数在两个单元格中返回结果:“Hello world” B2(这并不奇怪)和矩形区域C2(这是一只戴着帽子的兔子)。这两个结果以及“兔子”出现的地方都可以轻松定制。该工作由 VBA EVALUALTE命令完成。MagicSpell在这种情况下Adjacent(C2,3,4),变量的值在返回 UDF 结果之前从 UDF 内部触发。玩得开心!

回答by David Woolley

I've adapted your code to work for strings and functions and anything else in-between I hope (still testing).

我已经调整了您的代码以适用于字符串和函数以及我希望之间的任何其他内容(仍在测试中)。

Alot of questions resulting from testing, but 2 come to mind first:

测试产生了很多问题,但首先想到的是 2 个:

What other ways could you use to execute / process the parameters and return the desired results;

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

a. As I have done b. Not as I have done (i.e. differently).

一种。正如我所做的那样 b。不像我所做的(即不同)。

Many thanks to Rick Rothstein MrExcel MVP & many others on SO for enabling & helping for this to happen.

非常感谢 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