vba - Excel: 「kx + m」の文字列から k と m を検索

Question

VBAまたは式を使用して a の「k」および「m」変数を見つける賢い方法はありkx+m stringますか?

kx+m 文字列がどのように見えるかについては、いくつかのシナリオがあります。

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

等々。Excel で非常に複雑な数式を作成することで、これを解決できると確信していますが、誰かが既にこの問題や同様の問題を解決している可能性があると考えています。これまでのところ私のベストショットですが、まだすべての状況を処理しているわけではありません (kx+m 文字列に 2 つのマイナスがある場合など)。

=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

解析に煩わされるのではなくLINEST、VBA で簡単に実行します。

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

見た目よりも複雑です。私が間違っていなければ、kx+mには最大7つの演算子と最小の1つの演算子を含めることができます。そして、そのようなシナリオでは、「K」と「M」の値を取得することは非常に複雑になります。– SiddharthRout33分前

duffymoの投稿での私のコメントに基づいて

このスナップショットは、「kx+m」が持つことができるさまざまな組み合わせを示しています

そして先に示唆したように、あなたが望むものを達成することは非常に複雑です。これが、現時点で「 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

スナップショット

それほど多くはありませんが、これがあなたを正しい道に導いてくれることを願っています...

Answer 3

私はこれがあなたを助けると確信しています:)

この関数をモジュールに入れます:

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)

私は 2 番目の方法が好きです (少ない仕事:P)

さまざまな値でテストしましたが、取得したもののスクリーンショットは次のとおりです。

お役に立てれば ：）

Answer 4

正規表現を使用して 1 つ以上の数字を検索します。m の場合は "*x" の後、k の場合は "+" の後。

あなたの例は整数値を示しています。傾きと切片が浮動小数点数の場合はどうなりますか? 署名された値? あなたの例が示唆するよりも複雑です。

最も一般的な解決策は、それを処理する単純な文法でレクサー/パーサーを作成することです。VB または .NET が提供するものを知りません。ANTLR は、Java ランドでの 1 つのソリューションになります。ANTLR.NET があります。

このすべての努力があなたに何をもたらすかわかりません。抽出した内容はどうするのですか？y = m*x + k文字列を挿入して抽出するのではなく、ユーザーが k と m の数値型セルに入力してそれらから計算する方が簡単だと思います。

あなたの目標が単純に文字列を評価することである場合、おそらくeval()あなたの答えは次のとおりです。

文字列式を「実際の」式に変換する方法