我想创建一个用户定义的函数,在用字符串替换字符串中的变量后,它将解决指定单元格中的字符串方程。
信息始终分为两列。第一列的顶部将包含存储为字符串的公式。第一列的底部将包含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
更好的编码赞赏的建议(即选择范围超过细胞)
通过下面的个人的一些代码更正我到目前为止已经结束了。当单元格中的177.00出现时,它应该是176.86。更正:通过重新定义变量类型来解决最后一个问题,正如Chris在他的反馈中所做的那样。
答案 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