Home » excel » vba – Excel: Find k and m in "kx + m" text string

vba – Excel: Find k and m in "kx + m" text string

Posted by: admin March 9, 2020 Leave a comment

Questions:

Is there a clever way using VBA or a formula to find “k” and “m” variables in a kx+m string?

There are several scenarios for how the kx+m string can look, e.g.:

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

and so on. I’m pretty sure I can solve this by writing very complicating formulas in Excel, but I’m thinking maybe someone has already solved this and similar problems. Here is my best shot so far, but it doesn’t handle all situations yet (like when there are two minuses in the kx+m string:

=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));"")))

How to&Answers:

I’m sure this will help you 🙂

Put this function in a Module:

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

Then you can either call it from a Macro
e.g. like this:

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

Or use it like a formula.
e.g. by putting this in a cell:

=FindKXPlusM(B1)

I like the second way (less work :P)

I tested it with various values and here’s a screenshot of what I get:

Screenshot of Find KX+M Formula

Hope this helps 🙂

Answer:

Rather than bother with parsing run a simple LINEST in VBA.

Replace StrFunc as needed

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:

It is more complex than it seems. A kx+m can have Max 7 operators and min of 1 Operator if I am not wrong. And in such a scenario it becomes really complex to get the “K” and “M” values. – Siddharth Rout 33 mins ago

Building on my comment in duffymo’s post

This snapshot shows the different combinations that “kx + m” can have

enter image description here

And as suggested earlier, it is very complex to achieve what you want. Here is my feeble attempt to extract just “K” at the moment. This code is no way classy in any way 🙁 Also I have not tested the code with different scenarios so it may fail with others. However it gives you a fair idea on how to approach this problem. You will have to tweak it more to get the exact results that you want.

CODE (I am testing for 7 possible combinations in this code. It works for these 7 but might/will fail for others)

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

SNAPSHOT

enter image description here

It’s not much but I hope this gets you in the right path…

Answer:

I’d use a regular expression to search for one or more digits; after “*x” for m and after “+” for k.

Your example shows integer values. What if the slope and intercept are floating point numbers? Signed values? It’s more complicated than your example would suggest.

I would suggest that the most general solution would to write a lexer/parser with a simple grammar to handle it for you. I don’t know what VB or .NET offer for you. ANTLR would one solution in Java-land; there is an ANTLR.NET.

I’m not sure what all this effort buys you. What will you do with the extracted contents? I would think it’d be just as easy for users to fill in numeric type cells for k and m and calculate y = m*x + k from those rather than inserting a string and extracting them.

If your goal is simply to evaluate a String, maybe eval() is your answer:

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