2012-04-15 10 views
7

Có cách nào thông minh bằng cách sử dụng VBA hoặc công thức để tìm biến "k" và "m" trong kx+m string?Excel: Tìm k và m trong chuỗi văn bản "kx + m"

Có một số kịch bản cho cách kx + m chuỗi có thể nhìn, ví dụ .:

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

và vân vân. Tôi khá chắc chắn tôi có thể giải quyết điều này bằng cách viết các công thức rất phức tạp trong Excel, nhưng tôi nghĩ có lẽ ai đó đã giải quyết vấn đề này và tương tự. Đây là bức ảnh đẹp nhất của tôi cho đến nay, nhưng nó không xử lý mọi tình huống được nêu ra (như khi có hai nhược điểm trong chuỗi 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

+! cho một câu hỏi thú vị :) –

Trả lời

4

Tôi chắc chắn điều này sẽ giúp bạn :)

Đặt chức năng này trong Mô-đun:

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 

Sau đó, bạn có thể gọi từ Macro ví dụ: như thế này:

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

Hoặc sử dụng nó như một công thức. ví dụ: bằng cách đặt này trong một tế bào:

=FindKXPlusM(B1) 

Tôi thích cách thứ hai (ít công việc: P)

Tôi đã thử nghiệm nó với các giá trị khác nhau và đây là một ảnh chụp màn hình của những gì tôi nhận được:

Screenshot of Find KX+M Formula

Hy vọng điều này sẽ giúp :)

+2

+1 Đẹp nhất. Tôi thích cách bạn đang xử lý nếu nó là ngược lại :) –

+1

regexp là cách tốt nhất để phân tích chuỗi, nhưng phân tích là labourious cho applicationn này. – brettdj

3

Tôi muốn sử dụng một biểu thức chính quy để tìm kiếm một hoặc nhiều chữ số, sau "* x" cho m và sau dấu "+" cho k.

Ví dụ của bạn hiển thị giá trị số nguyên. Điều gì sẽ xảy ra nếu độ dốc và điểm chặn là số dấu phẩy động?

Tôi đề nghị giải pháp chung nhất để viết một từ vựng/phân tích cú pháp với một mẫu đơn giản mmar để xử lý nó cho bạn. Tôi không biết những gì VB hoặc .NET cung cấp cho bạn. ANTLR sẽ là một giải pháp trong đất Java; có một ANTLR.NET.

Tôi không chắc tất cả những nỗ lực này sẽ mua cho bạn. Bạn sẽ làm gì với nội dung được trích xuất? Tôi nghĩ rằng nó sẽ dễ dàng cho người dùng điền vào các ô số kiểu cho k và m và tính toán y = m*x + k từ những thay vì chèn một chuỗi và trích xuất chúng.

Nếu mục tiêu của bạn chỉ đơn giản là để đánh giá một String, có lẽ eval() là câu trả lời của bạn:

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

+0

+1 Tôi đồng ý với bạn :) Nó phức tạp hơn vẻ bề ngoài. Một 'kx + m' có thể có tối đa 7 toán tử và min của 1 toán tử nếu tôi không sai. Và trong một kịch bản như vậy nó trở nên thực sự phức tạp để có được các giá trị "K" và "M". –

4

Nó phức tạp hơn vẻ bề ngoài. Một kx + m có thể có tối đa 7 toán tử và tối thiểu của 1 toán tử nếu tôi không sai. Và trong một kịch bản như vậy nó trở nên thực sự phức tạp để có được các giá trị "K" và "M". - Siddharth rout 33 mins ago

Dựa trên nhận xét của tôi trong bài viết duffymo của

ảnh chụp này cho thấy các kết hợp khác nhau mà “kx + m” có thể có

enter image description here

Và như đã đề xuất trước đó, rất phức tạp để đạt được những gì bạn muốn. Đây là nỗ lực của tôi yếu ớt để chỉ trích xuất "K" tại thời điểm này. Mã này không có cách nào sang trọng theo bất kỳ cách nào :(Ngoài ra tôi chưa thử nghiệm mã với các kịch bản khác nhau nên có thể không thành công với người khác. Tuy nhiên, nó cung cấp cho bạn ý tưởng hợp lý về cách tiếp cận vấn đề này. tinh chỉnh thêm để có được kết quả chính xác mà bạn muốn.

CODE (Tôi đang thử nghiệm cho 7 kết hợp có thể có trong mã này.Nó hoạt động cho những 7 nhưng có thể/sẽ thất bại cho người khác)

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

Đó là không nhiều nhưng tôi hy vọng điều này giúp bạn trong con đường đúng đắn ...

+0

+1 cũng được xem là – brettdj

+0

+1 cái đẹp mà không cần Regexp –

5

Thay vì bận tâm với việc phân tích cú pháp chạy một đơn giản LINEST trong VBA.

Thay StrFunc khi cần thiết

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 Rất sáng tạo! – Excellll