Chỉnh Sủa đoạn code để có kết quả như ý muốn bóc tách diễn giải khối lượng XD (1 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
sdsd.jpgMình lấy đoạn code này trên mạng nhưng không biết chỉnh sửa nó ntn để ra kết quả như ý muôn
Mình muốn số trong khoanh đỏ thể hiện là đấu "," chứ không phải dấu "."
Function FD(mycell)
If mycell = "" Then
FD = ""
Else
If Left(mycell.Formula, 1) <> "=" Then
FD = "=Value"
Else

f = mycell.Formula
FD = f
End If
End If
Exit Function
End Function
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