(HELP) Nhờ các anh chị giúp em xử lý lại đoạn code dưới . Thank all (2 người xem)

[thanhdatx2bk]

Em có đoạn code chiết tính công thức nhưng kết quả không được như ý muốn vì kết quả thể hiện công thức bị mất số 0. ( Chi tiết theo file đính kèm)
Nhờ anh chị sửa giúp em với ạ .

Public Function CT(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
If rngData = "" Then Exit Function
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

CT = strText2
End Function

 

[snow25]

Em có đoạn code chiết tính công thức nhưng kết quả không được như ý muốn vì kết quả thể hiện công thức bị mất số 0. ( Chi tiết theo file đính kèm)
Nhờ anh chị sửa giúp em với ạ .

Public Function CT(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
If rngData = "" Then Exit Function
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

CT = strText2
End Function

Cho cai file len coi.

 

[thanhdatx2bk]

Cho cai file len coi.

Đây bác ơi, em không hiểu sao khi dùng hàm CTT đó , máy tính em thì không hiện được số =5*2*0.5 mà thành =5*2*.5 . Nhưng gửi sang máy tính người khác thì vẫn hiển thị được. Vậy có phải là do lỗi cài đặt excel hay lỗi code bác nhỉ