Ai chỉnh sửa hộ em cái code này được không A! (2 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

hdtamvt92

Thành viên mới
Tham gia
1/4/16
Bài viết
4
Được thích
0
Code diễn giải công thức:
nhưng bị 1 lỗi là lúc diễn giải công thức VD:
=(3,2+3,3) trả kết quả là (3.2+3.3) không như ý muốn:


code lấy từ diễn đàn:

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
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


Diengiai = "=" & strText2
End Function
 
Web KT

Bài viết mới nhất

Back
Top Bottom