Sửa code tách từng số trong chuỗi

[theducw87]

Chào các bác.
Em có code tách từng số trong chuỗi nhưng bị lỗi trường hợp số có dấu "."
Eụ thể với dòng "Ống gió tôn dày 0.58, kt 700x150" em dùng lệnh "=CtoNPlus(A1;1)" thì ra kết quả là 58700. Em mong muốn kết quả là 0.58
Em dùng lệnh "=CtoNPlus(A1;2)" thì ra kết quả là 150. Em mong muốn kết quả là 700.
Có bác nào am hiểu về đoạn mã này thì sửa lại giúp em với.
Em xin cảm ơn.
Code:

Public Newstr As String

Function CtoN(Mystr As String, Optional Dautp As String) As Double
Dim Kqng, Kqtp, Neg As Double, Kqtam As String
Dim Sotp As Double, Le As Byte
Neg = 1
Le = 0
For i = 1 To Len(Mystr)
tam = Mid(Mystr, i, 1)
Select Case tam
Case 0 To 9
Kqtam = Kqtam & tam
Case "-"
Neg = -1
Case Dautp
Kqng = Kqtam
Le = 1
Mystr = Right(Mystr, Len(Mystr) - i)
Kqtp = CtoN(Mystr)
Sotp = Kqtp * 10 ^ (-Len(Kqtp))
End Select
Next i
Select Case Le
Case 0
CtoN = IIf(Kqtam = "", 0, Kqtam)
Case 1
CtoN = Kqng + Sotp
End Select
CtoN = CtoN * Neg
End Function

Function CtoN1st(ByVal Mystr As String, Optional Dautp As String) As Double
Dim Kqng, Kqtp, Neg As Double, Kqtam As String
Dim Sotp As Double, Le As Byte, NewStr2 As String
Neg = 1
Le = 0
For i = 1 To Len(Mystr)
tam = Mid(Mystr, i, 1)
Select Case tam
Case 0 To 9
Kqtam = Kqtam & tam
If IsNumeric(Mid(Mystr, i + 1, 1)) = False And _
Mid(Mystr, i + 1, 1) <> "," And Mid(Mystr, i + 1, 1) <> "." Then
Newstr = Right(Mystr, Len(Mystr) - i)

Exit For
End If
Case "-"
Neg = -1
Case Dautp
Kqng = Kqtam
Le = 1
NewStr2 = Right(Mystr, Len(Mystr) - i)
Kqtp = CtoN1st(NewStr2)
Sotp = Kqtp * 10 ^ (-Len(Kqtp))

End Select
Next i
Select Case Le
Case 0
CtoN1st = IIf(Kqtam = "", 0, Kqtam)
Case 1

CtoN1st = Kqng + Sotp

End Select
CtoN1st = CtoN1st * Neg

End Function

Function CtoNPlus(Mystr As String, sttchuoi As Byte, Optional Dautp As String) As Double
Newstr = Mystr
For i = 1 To sttchuoi
If Len(Newstr) < 2 Then Exit For
CtoNPlus = CtoN1st(Newstr, Dautp)
Next i
Newstr = ""
End Function

 

[befaint]

A1 = "Ống gió tôn dày 0.58, kt 700x150"
B1 = getNumberByIndex($A$1, 1) '=0.58

Function getNumberByIndex(ByVal sText As String, Optional ByVal index As Long = 1) As Double
    Const sdeli = " "
    Dim i As Long, s As String
    Dim arr As Variant
    For i = 1 To VBA.Len(sText)
        s = VBA.Mid(sText, i, 1)
        If IsNumeric(s) = False Then
            If Not InStr(1, ". ", s, vbBinaryCompare) > 0 Then
                sText = Replace(sText, s, sdeli)
            End If
        End If
    Next i
    sText = WorksheetFunction.Trim(sText)
    arr = Split(sText, sdeli)
    index = index - 1
    If index > UBound(arr) Then index = UBound(arr)
    getNumberByIndex = arr(index)
End Function

 

[theducw87]

A1 = "Ống gió tôn dày 0.58, kt 700x150"
B1 = getNumberByIndex($A$1, 1) '=0.58

Function getNumberByIndex(ByVal sText As String, Optional ByVal index As Long = 1) As Double
    Const sdeli = " "
    Dim i As Long, s As String
    Dim arr As Variant
    For i = 1 To VBA.Len(sText)
        s = VBA.Mid(sText, i, 1)
        If IsNumeric(s) = False Then
            If Not InStr(1, ". ", s, vbBinaryCompare) > 0 Then
                sText = Replace(sText, s, sdeli)
            End If
        End If
    Next i
    sText = WorksheetFunction.Trim(sText)
    arr = Split(sText, sdeli)
    index = index - 1
    If index > UBound(arr) Then index = UBound(arr)
    getNumberByIndex = arr(index)
End Function

Em đã xử lý được như mong muốn rồi ạ. Cảm ơn bác nhiều.

 

[VetMini]

100,200,300 thì tính là 3 số 100 200 300 hay là 1 số 100200300 ?

 

[Maika8008]

100,200,300 thì tính là 3 số 100 200 300 hay là 1 số 100200300 ?

Dữ liệu của thớt chỉ mỗi 1 câu đó thì không ai đảm bảo viết hàm để có kết quả đúng với mọi trường hợp có trong dữ liệu thật.

 

[theducw87]

100,200,300 thì tính là 3 số 100 200 300 hay là 1 số 100200300 ?

tính 3 số 100 200 300 bác ạ

Bài đã được tự động gộp: 23/4/21

Dữ liệu của thớt chỉ mỗi 1 câu đó thì không ai đảm bảo viết hàm để có kết quả đúng với mọi trường hợp có trong dữ liệu thật.

Vâng, hiện tại nhu cầu của em cũng chỉ đơn giản như thế. Nếu lại gặp lỗi phức tạp hơn thì em lại hỏi

 

[VetMini]

Đây là bài toán kinh điển của kỹ thuật "phân chia nhiệm vụ hàm"
Bài này người ta viết làm hai hàm:
- Nhiệm vụ của hàm thứ nhất là duyệt (parse) chuỗi lấy ra một mảng số.
- Nhiệm vụ của hàm thứ hai là gọi hàm thứ nhất và lấy ra phần tử cần thiết (index). Hàm này có thể uốn éo theo nhiều kiểu, điển hình là nếu index missing thì trả về phần tử đầu tiên hay trả về cả mảng? Nếu index lớn hơn số phần tử thì error trả về thế nào?

Function DuyetChuoiLaySo(byVal s As String) As Variant
' returns an array of legit numbers found in in string s
Dim e As Variant
Dim a() As Double, ln As Long
Redim a(1 To 100)
For Each e in Split(Application.Trim(Replace(s, ",", " "), " ")
If IsNumeric(e) Then
ln = ln + 1
a(ln) = Val(e)
End If
Next e
Redim Preserve a(1 To Ln)
DuyetChuoiLaySo = a
End Function

Function SoThuN(byVal s As String, Optional byVal n As Long = -1) As Variant
' returns the nth number amongst the arrray of legit numbers found in in string s
' returns the whole array if n is negative
If n < 0 Then
SoThuN = DuyetChuoiLaySo(s)
Else
SoThuN = DuyetChuoiLaySo(s)(n)
End If
End Function