2012-04-15 61 views
7

是否有使用VBA或一個公式來找到一個kx+m string「K」和「M」的變量一個聰明的辦法?的Excel:查找「KX + M」文本字符串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));"")))

+2

+!對於一個有趣的問題:) – 2012-04-15 14:14:54

回答

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

希望這有助於:)

+2

+1不錯的一個。我喜歡你正在處理的方式,如果它是相反的:) – 2012-04-15 20:04:30

+1

regexp是解析字符串的最好方法,但解析對於這個應用程序來說是很麻煩的。 – brettdj 2012-04-16 09:55:18

3

我會使用一個正則表達式搜索一個或多個數字;在「* x」後爲m,在「+」後面爲k

您的示例顯示了整數值。建議。

我建議,最普遍的解決方案是寫一個詞法分析器/分析器用一個簡單的GRA mmar爲你處理它。我不知道VB或.NET爲你提供什麼。 ANTLR將在Java-land上提供一種解決方案;有一個ANTLR.NET。

我不知道這一切的努力給你買。你將如何處理提取的內容?我認爲這將會是一樣便於用戶在數字型細胞k和m填寫,並計算這些,而y = m*x + k不是插入一個字符串,並提取它們。

如果你的目標很簡單,就是評價一個字符串,也許eval()是你的答案:

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

+0

+1我同意你:)它比看起來更復雜。如果我沒有錯,'kx + m'可以有最多7個操作符和最少1個操作符。在這種情況下,獲得「K」和「M」值變得非常複雜。 – 2012-04-15 13:22:43

4

它比它看起來更爲複雜。如果我沒有錯,kx + m可以有最多7個操作符,最小1個操作符。在這種情況下,獲得「K」和「M」值變得非常複雜。 - 亞洲時報Siddharth潰敗33分鐘前

建立在我的duffymo的帖子評論

該快照顯示了不同的組合是「KX + M」可以有

enter image description here

正如前面所提到的,實現你想要的是非常複雜的。這是我愚蠢的嘗試此刻只提取「ķ」。 此代碼以任何方式 :(我也沒有測試用不同的場景的代碼,因此它可能會失敗,別人無路可走優雅,但它可以讓你對如何處理這個問題一個公平的想法,你將不得不調整它得到你想要的確切結果。

代碼(我正在測試此代碼中的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

這不是很多,但我希望這可以讓你在正確的道路......

+0

+1考慮得好 – brettdj 2012-04-16 04:11:07

+0

+1好的一個沒有Regexp – 2012-04-16 23:11:15

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

+1非常有創意! – Excellll 2012-04-16 16:35:02