如何引用从

时间:2016-02-29 21:20:00

标签: excel vba excel-vba

情况

我想创建一个用户定义的函数,在用字符串替换字符串中的变量后,它将解决指定单元格中的字符串方程。

信息始终分为两列。第一列的顶部将包含存储为字符串的公式。第一列的底部将包含UDF。公式和UDF之间将是字符串公式中的所有变量。第二列将包含变量的所有数值。

问题

我不知道如何在自动方法中选择信息列的顶部或UDF上方的变量,因为我不知道如何定义UDF所在的单元格的位置。

目的

引用UDF所在单元格的位置,以便可以定义公式单元格的位置和可变单元格的范围。我试图以一种方式编写UDF,我不必将它传递给公式单元格的地址或变量。我希望它能够根据UDF与单元格紧邻的所有信息自行获取信息。

我有什么

 Option Explicit

 Public Function SolvedEquation() As Long

 Dim FormulaCell As Range
 Dim Equation As String
 Dim VariableRange As Range
 Dim VariableCell As Range
 Dim VariablesLength As Integer
 Dim Variable As String
 Dim VariableValue As Double

 'define FormulaCell as the last nonblank up from the cell the function is called in from a contiguous range(no spaces)
 FormulaCell = Application.ThisCell.End(xlUp).Select

 'define the VariableRange as one up from the cell the function is called to second last cell non blank cell located upward in a contiguous selection (no spaces)
 VariableRange = Range(Cells(Application.ThisCell.Row - 1, Application.ThisCell.Column), Cells(FormulaCell.Row + 1, FormulaCell.Column))

 Equation = FormulaCell.Value

 For Each VariableCell In VariableRange.Cells

     VariablesLength = Len(VariableCell.Value)-1
     Variable = Left(VariableCell.Value, VariablesLength)
     VariableValue = Cells(VariableCell.Row, VariableCell.Column + 1).Value
     Equation = Replace(FormulaCell.Value, Variable, VariableValue)

 Next VariableCell

 SolvedEquation = Evaluate(Equation)

 End Function

更好的编码赞赏的建议(即选择范围超过细胞)

数据示例

enter image description here

通过下面的个人的一些代码更正我到目前为止已经结束了。当单元格中的177.00出现时,它应该是176.86。更正:通过重新定义变量类型来解决最后一个问题,正如Chris在他的反馈中所做的那样。

1 个答案:

答案 0 :(得分:1)

您的代码中存在许多与ThisCell

无直接关系的问题

参见内联评论

Public Function SolvedEquation() As Variant '~~> allow for Error result
    Dim FormulaCell As Range
    Dim Equation As String
    Dim VariableRange As Range
    Dim VariableCell As Range
    Dim VariablesLength As Integer
    Dim Variable As String
    Dim VariableValue As Double

    'define FormulaCell as the last nonblank up from the cell the function is called in from a contiguous range(no spaces)
    '~~> You must use Set and not use .Select
    '~~> but this wont give you what you want if the cell above ThisCell is blank
    'Set FormulaCell = Application.ThisCell.End(xlUp)
    '~~> use this instead
    If Application.ThisCell.Row <= 2 Then
        ' Function is in row 1 or 2.  What now?
        SolvedEquation = CVErr(xlErrNA)
        Exit Function
    Else
        If IsEmpty(Application.ThisCell.Offset(-1, 0)) Then
            Set FormulaCell = Application.ThisCell
        Else
            Set FormulaCell = Application.ThisCell.End(xlUp)
        End If
    End If

    'define the VariableRange as one up from the cell the function is called to second last cell non blank cell located upward in a contiguous selection (no spaces)
    '~~> use Set
    '~~> define worksheet
    '~~> simplify
    'VariableRange = Range(Cells(Application.ThisCell.Row - 1, Application.ThisCell.Column), Cells(FormulaCell.Row + 1, FormulaCell.Column))
    With Application.ThisCell
        Set VariableRange = Range(.Offset(-1, 0), FormulaCell.Offset(1, 0))
    End With
    Equation = FormulaCell.Value

    For Each VariableCell In VariableRange.Cells
        VariablesLength = Len(VariableCell.Value) '- 1
        Variable = Left$(VariableCell.Value, VariablesLength) '~~> string version of Left is faster
        VariableValue = VariableCell.Offset(0, 1).Value '~~> simplify
        Equation = Replace$(Equation, Variable, VariableValue) '~~> string version of Replace is faster, continue to work on Equation
    Next VariableCell

    SolvedEquation = Evaluate(Equation)

 End Function

也就是说,您的方法存在固有的问题,即当输入数据发生变化时它不会自动重新计算,因为函数调用中没有对源数据的引用。更好的方法是将Range参数传递给引用方程和源数据的UDF,如下所示

Public Function SolvedEquation2(rng As Range) As Variant
    Dim dat As Variant
    Dim Equation As Variant
    Dim i As Long

    ' copy range data to an array
    dat = rng.Value

    ' Verify size of range
    If UBound(dat, 1) < 2 Or UBound(dat, 2) < 2 Then
        SolvedEquation2 = CVErr(xlErrNA)
        Exit Function
    End If

    ' Solve equation
    Equation = dat(1, 1)
    For i = 2 To UBound(dat, 1)
        Equation = Replace$(Equation, dat(i, 1), dat(i, 2))
    Next
    ' Use Worksheet version of Evaluate
    SolvedEquation2 = rng.Worksheet.Evaluate(Equation)
 End Function

注意:我不明白为什么你需要像你一样操纵变量,所以我把它留了出来。如果需要 ,请使用一些示例数据和预期的公式字符串更新您的Q,我将更新A

根据您的样本,公式为SolvedEquation2(O129:P133)

注意:最好使用Evaluate的Worksheet版本。 See this link from Charles Williams' website for reason why

相关问题