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

Question

有没有巧妙的方法使用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));"")))

Answer 1

不必费心解析，在 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

Answer 2

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

将此函数放在一个模块中：

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）

我用各种值对其进行了测试，这是我得到的截图：

希望这会有所帮助:)

Answer 3

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

基于我在 duffymo 帖子中的评论

这个快照显示了“kx + m”可以有的不同组合

如前所述，实现您想要的目标非常复杂。这是我目前仅提取“K”的微弱尝试。 这段代码绝不是优雅的 :(另外我还没有测试过不同场景的代码，所以它可能会在其他情况下失败。但是它给了你一个公平的想法如何解决这个问题。您必须对其进行更多调整才能获得您想要的确切结果。

代码（我正在测试此代码中的 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

快照

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

Answer 4

我会使用正则表达式来搜索一个或多个数字；在 "*x" 之后表示 m，在 "+" 之后表示 k。

您的示例显示整数值。如果斜率和截距是浮点数怎么办？签名值？它比您的示例所建议的要复杂。

我建议最通用的解决方案是编写一个具有简单语法的词法分析器/解析器来为您处理它。我不知道 VB 或 .NET 为您提供什么。 ANTLR 是 Java 领域的一种解决方案；有一个 ANTLR.NET。

我不确定所有这些努力能给你带来什么。您将如何处理提取的内容？我认为用户为 k 和 m 填写数字类型单元格并从中计算 y = m*x + k 比插入字符串并提取它们同样容易。

如果您的目标只是评估一个字符串，也许eval() 是您的答案：

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