Nhờ giúp đỡ tách chuỗi số trong chuỗi ký tự rồi tính toán (1 người xem)

[vantu17783]

Xin chào toàn thể anh chị em trên diễn đàn. Em có một vấn đề muốn các bác chỉ giáo giúp. Em cần tách 1 chuỗi số từ chuỗi ký tự ra để tính toán. Trên diễn đàn đã có một số bài về tách số tính toán nhưng không sử dụng được trong trường hợp của em. Mong các bác giúp đỡ. Em xin cảm ơn trước ạ
VD:
Nội dung ở cột A: "Diễn giải giá trị tính toán: Bê tông móng cột: 3+4(5+5)+7 và bê tông phần thận cột : 4+6+5*2"
Giá trị sẽ trả về ở cột B: 70 (tức là giá trị ở cột B sẽ được tính bằng cách tách chuỗi số: [3+3+4(5+5)+7]+[4+6+5*2] =70)

 

[CHAOQUAY]

Xin chào toàn thể anh chị em trên diễn đàn. Em có một vấn đề muốn các bác chỉ giáo giúp. Em cần tách 1 chuỗi số từ chuỗi ký tự ra để tính toán. Trên diễn đàn đã có một số bài về tách số tính toán nhưng không sử dụng được trong trường hợp của em. Mong các bác giúp đỡ. Em xin cảm ơn trước ạ
VD:
Nội dung ở cột A: "Diễn giải giá trị tính toán: Bê tông móng cột: 3+4(5+5)+7 và bê tông phần thận cột : 4+6+5*2"
Giá trị sẽ trả về ở cột B: 70 (tức là giá trị ở cột B sẽ được tính bằng cách tách chuỗi số: [3+3+4(5+5)+7]+[4+6+5*2] =70)
View attachment 222524

Bạn nên gửi file đính kèm.

 

[vantu17783]

Em gửi lại file Attach. Nhờ các bác giúp đỡ với ạ.

 

[CHAOQUAY]

Em gửi lại file Attach. Nhờ các bác giúp đỡ với ạ.

Bạn chạy thử code này

Option Explicit
Sub Tinh()
Dim Nguon
Dim Kq
Dim i, j, k
j = Sheet1.Range("A1000000").End(xlUp).Row
Nguon = Sheet1.Range("A1", "A" & j)
k = UBound(Nguon)
ReDim Kq(1 To k - 1, 1 To 1)
With CreateObject("VbScript.RegExp")
    .Global = True
    .Pattern = "\D{4,}(\d)"
    For i = 2 To k
        Kq(i - 1, 1) = Evaluate(.Replace(Nguon(i, 1), "+" & "$1"))
    Next i
End With
With Sheet1
    .Range("B2", .Range("B1000000").End(xlUp)).ClearContents
    .Range("B2").Resize(k - 1, 1) = Kq
End With
End Sub

 

[vantu17783]

Cảm ơn bác CHAOQUAY nhé. Code của bác chạy rất ổn.
Nếu em muốn chuyển đoạn code đó thành 1 function (ví dụ: Tinh_kq), rồi dùng Function đó để tính toán ở bất kỳ một ô nào, trong bất kỳ Sheet nào của workbook thì phải sửa lại code ntn hả bác (Em gửi file đính kèm, mong bác bớt chút thời gian giúp đỡ. Cảm ơn bác!)