hakhoailang
Thành viên mới
- Tham gia
- 25/5/09
- Bài viết
- 30
- Được thích
- 1
mình có đoạn code sau cũng được tải từ diễn đàn mình với chức năng là diễn giải khối lượng nhưng nó có một lỗi cực kỳ oái oăm như sau:
VD:
ô A1 có giá trị là 2
ô B1 có công thức là 3*4
ô C1 = A1+B1
ô D1= dg(C1) thì lần đầu nó cho kết quả là chuỗi 2+3*4
nhưng sau khi tắt đi bật lại nó chỉ còn mỗi dấu +
còn nếu D1= dg(B1) thì nó lại cho kết quả đúng là chuỗi 3*4 dù tắt đi bật lại nó vẫn hiện thị đúng
Khi bắt đầu thực hiện thao tác thì mình add đoạn code này vào file excel để làm việc.
trong lần đầu sử dụng thì nó hiển thị rất mượt nhưng tắt đi bật lại là biết tay nhau.
nhờ các anh em trên diễn đàn giúp mình 1 tay để mình hoàn thành công việc như mong muốn với. Thank all.
VD:
ô A1 có giá trị là 2
ô B1 có công thức là 3*4
ô C1 = A1+B1
ô D1= dg(C1) thì lần đầu nó cho kết quả là chuỗi 2+3*4
nhưng sau khi tắt đi bật lại nó chỉ còn mỗi dấu +
còn nếu D1= dg(B1) thì nó lại cho kết quả đúng là chuỗi 3*4 dù tắt đi bật lại nó vẫn hiện thị đúng
Khi bắt đầu thực hiện thao tác thì mình add đoạn code này vào file excel để làm việc.
trong lần đầu sử dụng thì nó hiển thị rất mượt nhưng tắt đi bật lại là biết tay nhau.
nhờ các anh em trên diễn đàn giúp mình 1 tay để mình hoàn thành công việc như mong muốn với. Thank all.
Mã:
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
Function DG(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
DG = strText2
End Function
