从传递的列/行/范围VBA Excel中获取一个单元格

时间:2022-12-25 22:18:27

i'm writing a user defined function for excel in VBA.

我正在为VBA中的excel编写用户定义的函数。

User may pass a whole column/row into the function instead of one cell. How do you get cell that is in the same row (for column case) and in the same column (for row case), where the function is.

用户可以将整列/行传递给函数而不是一个单元格。如何获取位于同一行(对于列大小写)和同一列(对于行大小写)中的单元格。

For example, when you are writing in Excel in cell, say, C3 the formula "=A:A*B:B" it calculates A3*B3 in fact. I want to have the same behaiviour in my UDF.

例如,当您在单元格中使用Excel编写时,例如C3,公式“= A:A * B:B”实际上计算A3 * B3。我想在我的UDF中拥有相同的行为。

Let's assume function that returns passed argument for simplicity reasons. This code does not work (returns #VALUE! for columns/rows/ranges):

让我们假设函数返回传递的参数,原因很简单。此代码不起作用(对于列/行/范围返回#VALUE!):

Public Function MyTestFunction(ByVal arg1) As Variant
    MyTestFunction = arg1
End Function

My option is as follows, but I am concerned about performance and the fact that user may want to pass a value to the formula instead of Range.

我的选项如下,但我担心性能以及用户可能希望将值传递给公式而不是Range的事实。

Public Function MyTestFunction2(ByVal arg1 As Range) As Variant

    If arg1.Count = 1 Then
        MyTestFunction2 = arg1.Value
    Else
        ' Vertical range
        If arg1.Columns.Count = 1 Then
            MyTestFunction2 = arg1.Columns(1).Cells(Application.Caller.Row, 1).Value
            Exit Function
        End If

        ' Horizontal range
        If arg1.Rows.Count = 1 Then
            MyTestFunction2 = arg1.Rows(1).Cells(1, Application.Caller.Column).Value
            Exit Function
        End If

        ' Return #REF! error to user
        MyTestFunction2 = CVErr(xlErrRef)
    End If

End Function

How do you solve this problem?

你怎么解决这个问题?


Thanks to valuable comments code has been slightly updated and now can be used in other formulas to filter input values.

感谢有价值的评论代码已略有更新,现在可以在其他公式中使用来过滤输入值。

Public Function MyTestFunction2(ByVal arg1) As Variant

    If Not TypeName(arg1) = "Range" Then
        MyTestFunction2 = arg1
        Exit Function
    End If


    If arg1.Count = 1 Then
        MyTestFunction2 = arg1.Value
    Else
        ' Vertical range
        If arg1.Columns.Count = 1 Then
            ' check for range match current cell
            If arg1.Cells(1, 1).Row > Application.Caller.Row Or _
                arg1.Cells(1, 1).Row + arg1.Rows.Count - 1 < Application.Caller.Row Then
                ' Return #REF! error to user
                MyTestFunction2 = CVErr(xlErrRef)
                Exit Function
            End If

            ' return value from cell matching cell with function
            MyTestFunction2 = arg1.Worksheet.Columns(1).Cells(Application.Caller.Row, arg1.Column).Value
            Exit Function
        End If

        ' Horizontal range
        If arg1.Rows.Count = 1 Then
            ' check for range match current cell
            If arg1.Cells(1, 1).Column > Application.Caller.Column Or _
                arg1.Cells(1, 1).Column + arg1.Columns.Count - 1 < Application.Caller.Column Then
                ' Return #REF! error to user
                MyTestFunction2 = CVErr(xlErrRef)
                Exit Function
            End If

            ' return value from cell matching cell with function
            MyTestFunction2 = arg1.Worksheet.Rows(1).Cells(arg1.Row, Application.Caller.Column).Value
            Exit Function
        End If

        ' Return #REF! error to user
        MyTestFunction2 = CVErr(xlErrRef)
    End If

End Function

2 个解决方案

#1


1  

In the first code snippet change MyTestFunction = arg1 to Set MyTestFunction = arg1. Also add a small mechanism that recognizes the TypeName() of the arg1 and make sure that the function is receiving a Range type object.

在第一个代码片段中,将MyTestFunction = arg1更改为Set MyTestFunction = arg1。还添加一个识别arg1的TypeName()的小机制,并确保该函数正在接收Range类型对象。

Public Function MyTestFunction(ByVal arg1) As Variant
    Set MyTestFunction = arg1
End Function

example

从传递的列/行/范围VBA Excel中获取一个单元格


Then, if you get to your spreadsheet and type in =MyTestFunction(A:A) on any row and you'll receive the equivalent value from the column you're passing to the function that sits on the same row.

然后,如果您到达电子表格并在任何行上键入= MyTestFunction(A:A),您将从您传递给位于同一行的函数的列中收到等效值。

And your second idea about getting a similar behaviour as =A:A*B:B you can achieve with

你的第二个想法是获得类似的行为= A:A * B:B你可以实现

Public Function MyTestFunction2(ParamArray arr() As Variant) 
    MyTestFunction2 = arr(0)
End Function

example

从传递的列/行/范围VBA Excel中获取一个单元格

#2


1  

I think you need to use Application.ThisCell property to do it. According to MSDN:

我认为你需要使用Application.ThisCell属性来做到这一点。根据MSDN:

Application.ThisCell- Returns the cell in which the user-defined function is being called from as a Range object.

Application.ThisCell-返回从中调用用户定义函数的单元格作为Range对象。

Let me present how to use it on simple example. Imagine we have data as presented below in column A:B and we want to achieve results which comes from =A*B for each row separately.

让我介绍如何在简单的例子中使用它。想象一下,我们在A:B列中有如下所示的数据,我们希望分别得到每行= A * B的结果。

从传递的列/行/范围VBA Excel中获取一个单元格

In such situation you need the function below and put it next in C column in this way: =MyTestFunction(A:A,B:B)

在这种情况下,你需要下面的函数,并以这种方式将它放在C列中:= MyTestFunction(A:A,B:B)

Function MyTestFunction(rngA As Range, rngB As Range)

    Dim funRow As Long
        funRow = Application.ThisCell.Row
    MyTestFunction = rngA(funRow) * rngB(funRow)

End Function

Please keep in mind that Application.ThisCell will not work if you call your function from other VBA procedure.

请记住,如果从其他VBA程序调用您的函数,Application.ThisCell将不起作用。

#1


1  

In the first code snippet change MyTestFunction = arg1 to Set MyTestFunction = arg1. Also add a small mechanism that recognizes the TypeName() of the arg1 and make sure that the function is receiving a Range type object.

在第一个代码片段中,将MyTestFunction = arg1更改为Set MyTestFunction = arg1。还添加一个识别arg1的TypeName()的小机制,并确保该函数正在接收Range类型对象。

Public Function MyTestFunction(ByVal arg1) As Variant
    Set MyTestFunction = arg1
End Function

example

从传递的列/行/范围VBA Excel中获取一个单元格


Then, if you get to your spreadsheet and type in =MyTestFunction(A:A) on any row and you'll receive the equivalent value from the column you're passing to the function that sits on the same row.

然后,如果您到达电子表格并在任何行上键入= MyTestFunction(A:A),您将从您传递给位于同一行的函数的列中收到等效值。

And your second idea about getting a similar behaviour as =A:A*B:B you can achieve with

你的第二个想法是获得类似的行为= A:A * B:B你可以实现

Public Function MyTestFunction2(ParamArray arr() As Variant) 
    MyTestFunction2 = arr(0)
End Function

example

从传递的列/行/范围VBA Excel中获取一个单元格

#2


1  

I think you need to use Application.ThisCell property to do it. According to MSDN:

我认为你需要使用Application.ThisCell属性来做到这一点。根据MSDN:

Application.ThisCell- Returns the cell in which the user-defined function is being called from as a Range object.

Application.ThisCell-返回从中调用用户定义函数的单元格作为Range对象。

Let me present how to use it on simple example. Imagine we have data as presented below in column A:B and we want to achieve results which comes from =A*B for each row separately.

让我介绍如何在简单的例子中使用它。想象一下,我们在A:B列中有如下所示的数据,我们希望分别得到每行= A * B的结果。

从传递的列/行/范围VBA Excel中获取一个单元格

In such situation you need the function below and put it next in C column in this way: =MyTestFunction(A:A,B:B)

在这种情况下,你需要下面的函数,并以这种方式将它放在C列中:= MyTestFunction(A:A,B:B)

Function MyTestFunction(rngA As Range, rngB As Range)

    Dim funRow As Long
        funRow = Application.ThisCell.Row
    MyTestFunction = rngA(funRow) * rngB(funRow)

End Function

Please keep in mind that Application.ThisCell will not work if you call your function from other VBA procedure.

请记住,如果从其他VBA程序调用您的函数,Application.ThisCell将不起作用。