Nhờ trợ giúp sửa VBA tính diễn giải khối lượng

[PhiTQ-ME]

Chả là em có 1 VBA này để tính tổng các vùng diễn giải nhưng có ô trên 255 ký tự thì không tính được.
Nhờ các cao nhân hỗ trợ xử lý - trả phí.
Em cũng không biết gì về VBA nên xin chỉ giáo.

Bài đã được tự động gộp: 23/4/24

Bài đã được tự động gộp: 23/4/24

 

[bebo021999]

Viết bằng basic à, thấy file có đuôi .bas.
Bạn post lại file excel nhé.

 

[PhiTQ-ME]

File Book 1 của em là bị giới hạn 255 ký tự ở ô, còn file 2 thì không tính được phép nhân. Em muốn 1 hàm có thể xử lý được 2 đề bài

 

[BuiQuangThuan]

thử code này tham khảo xem sao?

Function TT(ParamArray mang() As Variant) As Double
      Dim T, A As Double, T1, n As Long, Tam$
      For Each T In mang
         For Each T1 In T
            n = 1
            If T1 <> Empty Then
                If Len(T1) > 255 Then
                    For n = n To Len(T1)
                        Tam = Mid(T1, n, 255)
                        s = InStr(1, StrReverse(Mid(T1, n, 255)), "+")
                        Tam = Mid(T1, n, 255 - s)
                        If Right(Tam, 1) = "+" Then
                            Tam = Left(Tam, Len(Tam) - 1)
                        End If
                        A = A + Evaluate("=" & Replace(Tam, ",", "."))
                        n = n + Len(Tam)
                    Next
                Else
                   A = A + Evaluate("=" & Replace(T1, ",", "."))
                End If
            End If
         Next
      Next
      TT = A
End Function

 

[VetMini]

Viết bằng basic à, thấy file có đuôi .bas.
Bạn post lại file excel nhé.

Module của VBA nếu export ra thì đuôi là BAS.
Dòng đầu có thêm cái Attribute mà VBE đọc sẽ hiểu cách import trở lại.

 

[PhiTQ-ME]

thử code này tham khảo xem sao?

Function TT(ParamArray mang() As Variant) As Double
      Dim T, A As Double, T1, n As Long, Tam$
      For Each T In mang
         For Each T1 In T
            n = 1
            If T1 <> Empty Then
                If Len(T1) > 255 Then
                    For n = n To Len(T1)
                        Tam = Mid(T1, n, 255)
                        s = InStr(1, StrReverse(Mid(T1, n, 255)), "+")
                        Tam = Mid(T1, n, 255 - s)
                        If Right(Tam, 1) = "+" Then
                            Tam = Left(Tam, Len(Tam) - 1)
                        End If
                        A = A + Evaluate("=" & Replace(Tam, ",", "."))
                        n = n + Len(Tam)
                    Next
                Else
                   A = A + Evaluate("=" & Replace(T1, ",", "."))
                End If
            End If
         Next
      Next
      TT = A
End Function

Code dùng được, có giá trị rất cao bác ạ. Em cảm ơn bác nhiều

 

[bebo021999]

Một cách khác:

Option Explicit
Function tinhtong(vung As Range) As Double
Dim i&, j&, m&, st$, sp, s, c As Double, cell As Range
For Each cell In vung
    st = Replace(cell.Value, ",", ".")
    sp = Split(st, "+")
    For i = 0 To UBound(sp)
        If IsNumeric(Evaluate("=" & sp(i))) Then
            c = c + Evaluate("=" & sp(i))
        Else
            For j = i + 1 To UBound(sp)
                sp(j) = sp(i) & "+" & sp(j)
                m = m + 1
                If IsNumeric(Evaluate("=" & sp(j))) Then
                    c = c + Evaluate("=" & sp(j))
                    i = i + m
                    Exit For
                End If
            Next
        End If
    Next
Next
tinhtong = c
End Function

 

[PhiTQ-ME]

Một cách khác:

Option Explicit
Function tinhtong(vung As Range) As Double
Dim i&, j&, m&, st$, sp, s, c As Double, cell As Range
For Each cell In vung
    st = Replace(cell.Value, ",", ".")
    sp = Split(st, "+")
    For i = 0 To UBound(sp)
        If IsNumeric(Evaluate("=" & sp(i))) Then
            c = c + Evaluate("=" & sp(i))
        Else
            For j = i + 1 To UBound(sp)
                sp(j) = sp(i) & "+" & sp(j)
                m = m + 1
                If IsNumeric(Evaluate("=" & sp(j))) Then
                    c = c + Evaluate("=" & sp(j))
                    i = i + m
                    Exit For
                End If
            Next
        End If
    Next
Next
tinhtong = c
End Function

Cảm ơn bác đã bớt thời gian để xử lý. Em sẽ xem hàm ạ

 

[bebo021999]

Cảm ơn bác đã bớt thời gian để xử lý. Em sẽ xem hàm ạ

Bạn cần lưu ý trường hợp đặc biệt: đó là luật nhân chia trước, cộng trừ sau ở bên trong dấu ngoặc. VD:
...+2*3*(6/2+ 3*4-2*3)/5*6+....
Giả sử biểu thức này nằm trong vùng ký tự 255, nếu tách ra là
<255:
...+2*3*(6/2+ 3
>255:
*4-2*3)/5*6+....
Mình chưa test cái này, vì không biết data của bạn có t/h này hay không.
Bạn có thể test thử để xem kết quả 2 code trên có đúng không nhé

 

[PhiTQ-ME]

Bạn cần lưu ý trường hợp đặc biệt: đó là luật nhân chia trước, cộng trừ sau ở bên trong dấu ngoặc. VD:
...+2*3*(6/2+ 3*4-2*3)/5*6+....
Giả sử biểu thức này nằm trong vùng ký tự 255, nếu tách ra là
<255:
...+2*3*(6/2+ 3
>255:
*4-2*3)/5*6+....
Mình chưa test cái này, vì không biết data của bạn có t/h này hay không.
Bạn có thể test thử để xem kết quả 2 code trên có đúng không nhé

Dạ bác ạ. Em test rồi có gì thông tin ạ