Code diễn giải công thức, không cập nhật khi sửa ở cột công thức ?

[sony2007]

Code diễn giải công thức, không cập nhật diễn giải khi sửa ở cột công thức. Các bác xem giúp với nhé.
Đây là đoạn code diễn giải công thức:
------------------------------------------------
Option Explicit
Public Function Diengiai(rngData As Range)
Dim strText As String, strText2 As String
Dim i As Long, j As Long, dem As Long
Dim subText() As String, dau() As String
Dim Res As Double
strText = rngData.Formula

For i = 1 To Len(strText)
Select Case Mid(strText, i, 1)
Case "+", "-", "*", "/", "^"
ReDim Preserve dau(j)
dau(j) = Mid(strText, i, 1)
j = j + 1
End Select
Next i

strText = Replace(strText, "=", "")
strText = Replace(strText, "+", "@")
strText = Replace(strText, "-", "@")
strText = Replace(strText, "*", "@")
strText = Replace(strText, "/", "@")
strText = Replace(strText, "\", "@")
strText = Replace(strText, "^", "@")

strText = Trim(strText)

subText = Split(strText, "@")
For i = 0 To UBound(subText)
On Error Resume Next
If Not IsNumeric(subText(i)) Then
Err.Clear
Res = Application.WorksheetFunction.Find("(", subText(i))
If Err.Number = 0 Then
dem = 0
For j = 1 To Len(subText(i))
If Mid(subText(i), j, 1) = "(" Then dem = dem + 1
Next j
subText(i) = Replace(subText(i), "(", "")
If IsNumeric(subText(i)) Then
subText(i) = String(dem, "(") & subText(i)
Else
subText(i) = String(dem, "(") & Range(subText(i)).Value
End If
End If

Err.Clear
Res = Application.WorksheetFunction.Find(")", subText(i))
If Err.Number = 0 Then
dem = 0
For j = 1 To Len(subText(i))
If Mid(subText(i), j, 1) = ")" Then dem = dem + 1
Next j
subText(i) = Replace(subText(i), ")", "")
If IsNumeric(subText(i)) Then
subText(i) = subText(i) & String(dem, ")")
Else
subText(i) = Range(subText(i)).Value & String(dem, ")")
End If
End If

subText(i) = Range(subText(i)).Value

End If
Next i

ReDim Preserve dau(UBound(subText))
For i = 0 To UBound(subText)
strText2 = strText2 & subText(i) & dau(i)
Next i

Diengiai = strText2
End Function

-----------------------------------------------------------------



và đây là file. Khi ở sheet hiện tại thì công thức bình thường. Copy nguyên sheet thì khi sửa giá trị công thức, thì diễn giải k thay đổi. Kể cả khi lưu lại và mở ra.

 

[sony2007]

Code diễn giải công thức, không cập nhật diễn giải khi sửa ở cột công thức. Các bác xem giúp với nhé.
Đây là đoạn code diễn giải công thức:
------------------------------------------------
Option Explicit
Public Function Diengiai(rngData As Range)
Dim strText As String, strText2 As String
Dim i As Long, j As Long, dem As Long
Dim subText() As String, dau() As String
Dim Res As Double
strText = rngData.Formula

For i = 1 To Len(strText)
Select Case Mid(strText, i, 1)
Case "+", "-", "*", "/", "^"
ReDim Preserve dau(j)
dau(j) = Mid(strText, i, 1)
j = j + 1
End Select
Next i

strText = Replace(strText, "=", "")
strText = Replace(strText, "+", "@")
strText = Replace(strText, "-", "@")
strText = Replace(strText, "*", "@")
strText = Replace(strText, "/", "@")
strText = Replace(strText, "\", "@")
strText = Replace(strText, "^", "@")

strText = Trim(strText)

subText = Split(strText, "@")
For i = 0 To UBound(subText)
On Error Resume Next
If Not IsNumeric(subText(i)) Then
Err.Clear
Res = Application.WorksheetFunction.Find("(", subText(i))
If Err.Number = 0 Then
dem = 0
For j = 1 To Len(subText(i))
If Mid(subText(i), j, 1) = "(" Then dem = dem + 1
Next j
subText(i) = Replace(subText(i), "(", "")
If IsNumeric(subText(i)) Then
subText(i) = String(dem, "(") & subText(i)
Else
subText(i) = String(dem, "(") & Range(subText(i)).Value
End If
End If

Err.Clear
Res = Application.WorksheetFunction.Find(")", subText(i))
If Err.Number = 0 Then
dem = 0
For j = 1 To Len(subText(i))
If Mid(subText(i), j, 1) = ")" Then dem = dem + 1
Next j
subText(i) = Replace(subText(i), ")", "")
If IsNumeric(subText(i)) Then
subText(i) = subText(i) & String(dem, ")")
Else
subText(i) = Range(subText(i)).Value & String(dem, ")")
End If
End If

subText(i) = Range(subText(i)).Value

End If
Next i

ReDim Preserve dau(UBound(subText))
For i = 0 To UBound(subText)
strText2 = strText2 & subText(i) & dau(i)
Next i

Diengiai = strText2
End Function

-----------------------------------------------------------------



và đây là file. Khi ở sheet hiện tại thì công thức bình thường. Copy nguyên sheet thì khi sửa giá trị công thức, thì diễn giải k thay đổi. Kể cả khi lưu lại và mở ra.

không thấy bác nào giúp đỡ cả. Có ai đó giúp tôi với

 

[sealand]

Hàm của bạn để ở dang Ad-In chắc là có vấn đề về Load Ad-In còn khi mình đưa trực tiếp vào File nó bình thường mà.
Mình có sửa 1 chút Hàm và công thức để khi ô tính toán trống thì diễn giải cũng trống