Excel:在“kx + m”文本字符串中查找k和m

时间:2012-04-15 13:09:26

标签: excel vba excel-vba excel-formula

是否有一种聪明的方法使用VBA或公式在kx+m string中找到“k”和“m”变量?

kx + m字符串的外观有几种情况,例如:

312*x+12
12+x*2
-4-x

等等。我很确定我可以通过在Excel中编写非常复杂的公式来解决这个问题,但我想也许有人已经解决了这个和类似的问题。这是我到目前为止最好的拍摄,但它还没有处理所有情况(比如kx + m字符串中有两个缺点:

=TRIM(IF(NOT(ISERROR(SEARCH("~+";F5))); IF(SEARCH("~+";F5)>SEARCH("~*";F5);RIGHT(F5;LEN(F5)-SEARCH("~+";F5));LEFT(F5;SEARCH("~+";F5)-1)); IF(NOT(ISERROR(SEARCH("~-";F5))); IF(SEARCH("~-";F5)>SEARCH("~*";F5);RIGHT(F5;LEN(F5)-SEARCH("~-";F5)+1);LEFT(F5;SEARCH("~*";F5)-1));"")))

4 个答案:

答案 0 :(得分:5)

而不是费心解析在VBA中运行简单的LINEST

根据需要替换StrFunc

Sub Extract()
Dim strFunc As String
Dim X(1 To 2) As Variant
Dim Y(1 To 2) As Variant
Dim C As Variant

X(1) = 0
X(2) = 100

strFunc = "312*x+12"
'strFunc = "12+x*2 "
'strFunc = "-4-X"

Y(1) = Evaluate(Replace(LCase$(strFunc), "x", X(1)))
Y(2) = Evaluate(Replace(LCase$(strFunc), "x", X(2)))
C = Application.WorksheetFunction.LinEst(Y, X)

MsgBox "K is " & C(1) & vbNewLine & "M is " & C(2)

End Sub

答案 1 :(得分:4)

  
    
      

它比看起来更复杂。如果我没有错,则kx + m可以有最多7个运算符,最小值为1运算符。在这种情况下,获得“K”和“M”值变得非常复杂。 - Siddharth Rout 33分钟前

    
  

以我在duffymo的帖子中的评论为基础

此快照显示“kx + m”可以具有的不同组合

enter image description here

如前所述,实现你想要的东西非常复杂。这是我微弱的尝试,目前只提取“ K ”。 此代码无论如何都不是优雅的 :(我还没有使用不同的方案测试代码,因此可能会失败。但是它会给你一个公平的想法如何解决这个问题。你需要进一步调整它以获得你想要的确切结果。

CODE (我正在测试此代码中的7种可能的组合。它适用于这7种情况,但可能/将会因其他情况而失败)

Option Explicit

Sub Sample()
    Dim StrCheck As String
    Dim posStar As Long, posBrk As Long, pos As Long, i As Long
    Dim strK As String, strM As String
    Dim MyArray(6) As String

    MyArray(0) = "-k*(-x)+(-m)*(-2)"
    MyArray(1) = "-k*x+(-m)*(-2)"
    MyArray(2) = "-k(x)+(-m)*(-2)"
    MyArray(3) = "-k(x)+(-m)(-2)"
    MyArray(4) = "-kx+m"
    MyArray(5) = "kx+m"
    MyArray(6) = "k(x)+m"

    For i = 0 To 6
        StrCheck = MyArray(i)
        Select Case Left(Trim(StrCheck), 1)

        Case "+", "-"
            posBrk = InStr(2, StrCheck, "(")
            posStar = InStr(2, StrCheck, "*")

            If posBrk > posStar Then            '<~~ "-k*(-x)+(-m)*(-2)"
                pos = InStr(2, StrCheck, "*")
                If pos <> 0 Then
                    strK = Mid(StrCheck, 1, pos - 1)
                Else
                    strK = Mid(StrCheck, 1, posBrk - 1)
                End If
            ElseIf posBrk < posStar Then        '<~~ "-k(-x)+(-m)*(-2)"
                pos = InStr(2, StrCheck, "(")
                strK = Mid(StrCheck, 1, pos - 1)
            Else                                '<~~ "-kx+m"
                '~~> In such a case I am assuming that you will never use
                '~~> a >=2 letter variable
                strK = Mid(StrCheck, 1, 2)
            End If
        Case Else
            posBrk = InStr(1, StrCheck, "(")
            posStar = InStr(1, StrCheck, "*")

            If posBrk > posStar Then            '<~~ "k*(-x)+(-m)*(-2)"
                pos = InStr(1, StrCheck, "*")
                If pos <> 0 Then
                    strK = Mid(StrCheck, 1, pos - 2)
                Else
                    strK = Mid(StrCheck, 1, posBrk - 1)
                End If
            ElseIf posBrk < posStar Then        '<~~ "k(-x)+(-m)*(-2)"
                pos = InStr(1, StrCheck, "(")
                strK = Mid(StrCheck, 1, pos - 2)
            Else                                '<~~ "kx+m"
                '~~> In such a case I am assuming that you will never use
                '~~> a >=2 letter variable
                strK = Mid(StrCheck, 1, 1)
            End If
        End Select

        Debug.Print "Found " & strK & " in " & MyArray(i)
    Next i
End Sub

<强>快照

enter image description here

这并不多,但我希望这会让你走上正确的道路......

答案 2 :(得分:4)

我相信这会对你有所帮助:)。

将此功能放入模块:

Function FindKXPlusM(ByVal str As String) As String
    Dim K As String, M As String
    Dim regex As Object, matches As Object, sm As Object

    '' remove unwanted spaces from input string (if any)
    str = Replace(str, " ", "")

    '' create an instance of RegEx object.
    '' I'm using late binding here, but you can use early binding too.
    Set regex = CreateObject("VBScript.RegExp")
    regex.IgnoreCase = True
    regex.Global = True

    '' test for kx+m or xk+m types
    regex.Pattern = "^(-?\d*)\*?x([\+-]?\d+)?$|^x\*(-?\d+)([\+-]?\d+)?$"
    Set matches = regex.Execute(str)
    If matches.Count >= 1 Then
        Set sm = matches(0).SubMatches
        K = sm(0)
        M = sm(1)
        If K = "" Then K = sm(2)
        If M = "" Then M = sm(3)
        If K = "-" Or K = "+" Or K = "" Then K = K & "1"
        If M = "" Then M = "0"
    Else
        '' test for m+kx or m+xk types
        regex.Pattern = "^(-?\d+)[\+-]x\*([\+-]?\d+)$|^(-?\d+)([\+-]\d*)\*?x$"
        Set matches = regex.Execute(str)
        If matches.Count >= 1 Then
            Set sm = matches(0).SubMatches
            M = sm(0)
            K = sm(1)
            If M = "" Then M = sm(2)
            If K = "" Then K = sm(3)
            If K = "-" Or K = "+" Or K = "" Then K = K & "1"
            If M = "" Then M = "0"
        End If
    End If
    K = Replace(K, "+", "")
    M = Replace(M, "+", "")

    '' the values found are in K & M.
    '' I output here in this format only for showing sample.
    FindKXPlusM = " K = " & K & "         M = " & M
End Function

然后你可以从宏调用它 例如像这样:

Sub Test()
    Debug.Print FindKXPlusM("x*312+12")
End Sub

或者像公式一样使用它。 例如把它放在一个单元格中:

=FindKXPlusM(B1)

我喜欢第二种方式(减少工作量:P)

我用不同的值测试了它,这是我得到的截图:

Screenshot of Find KX+M Formula

希望这会有所帮助:)

答案 3 :(得分:3)

我使用正则表达式来搜索一个或多个数字;在“* x”表示m之后,“+”之后表示k。

您的示例显示整数值。如果斜率和截距是浮点数怎么办?签名值?它比你的例子更复杂。

我建议最常用的解决方案是编写一个带有简单语法的词法分析器/解析器来为你处理它。我不知道VB或.NET为您提供什么。 ANTLR是Java-land中的一种解决方案;有一个ANTLR.NET。

我不确定所有这些努力会给你带来什么。您将如何处理提取的内容?我认为用户可以很容易地为k和m填充数字类型单元格并从中计算y = m*x + k而不是插入字符串并将其提取出来。

如果您的目标只是评估字符串,那么eval()可能是您的答案:

How to turn a string formula into a "real" formula