Tách chuỗi để lấy gia trị số (1 người xem)

vanduynguyen1983 · 10/7/13

[TABLE="width: 511"]
[TR]
[TD="class: xl207, width: 511, colspan: 5"]Anh chị dùng hàm tách dùm em chuỗi lộn xộn trên để ra đươc các con số ở C,D,E e có đính kèm file mong anh chi coi dùm em[/TD]
[/TR]
[/TABLE]

hoamattroicoi · 10/7/13

Thử code này xem :

PHP:

Sub Tachso()
    Dim ReG As Object, REMatches, j As Long, i As Long, k As Long
    Set ReG = CreateObject("vbscript.regexp")
    For i = 5 To 18
    With ReG
        .Global = True
        .Pattern = "\d+"
       Set REMatches = ReG.Execute(Cells(i, 2).Value)
    End With
            j = 2
                   For k = 0 To 2
                    j = j + 1
                    Cells(i, j).Value = REMatches(k)
                  Next
   Next
End Sub

Hị hị hị - Xem lại kết quả mẫu thì thấy k có quy luật nào - code phá sản, ẹ ẹ ẹ - chỉ có thể dùng cái này làm trung gian ĐỠ TẠM thôi người ơi, hix hix

dhn46 · 10/7/13

Bài này nếu dữ liệu đúng kiểu bạn đưa thì bạn thử phương pháp công thức sau
Tại C5

Mã:

=LOOKUP(99^99,--MID(B5,MIN(FIND({0,1,2,3,4,5,6,7,8,9},B5&"0123456789")),ROW(INDIRECT("1:"&LEN(B5)))))

Tại B5

Mã:

=LOOKUP(99^99,--MID(SUBSTITUTE(SUBSTITUTE(RIGHT(B5,LEN(B5)-SEARCH("d",B5,1)),",","x")," ","x"),MIN(FIND({0,1,2,3,4,5,6,7,8,9},SUBSTITUTE(SUBSTITUTE(RIGHT(B5,LEN(B5)-SEARCH("d",B5,1)),",","x")," ","x")&"0123456789")),ROW(INDIRECT("1:"&LEN(B5)))))

Tại D5

Mã:

=LOOKUP(99^99,--MID(RIGHT(SUBSTITUTE(SUBSTITUTE(B5,",","x")," ","x"),LEN(B5)-SEARCH("x",SUBSTITUTE(SUBSTITUTE(B5,",","x")," ","x"),1)),MIN(FIND({0,1,2,3,4,5,6,7,8,9},RIGHT(SUBSTITUTE(SUBSTITUTE(B5,",","x")," ","x"),LEN(B5)-SEARCH("x",SUBSTITUTE(SUBSTITUTE(B5,",","x")," ","x"),1))&"0123456789")),ROW(INDIRECT("1:"&LEN(B5)))))

=> kéo hết dữ liệu để có kết quả

hoamattroicoi · 10/7/13

He he he - cái đầu tiên có thể ngắn chút dhn46 ạ :

PHP:

=--LEFT(B5,COUNT(--LEFT(B5,COLUMN(INDIRECT("1:"&LEN(B5))))))

Cái thứ 2 thì không cần quan tâm chữ "d" vậy, tớ lại quan tâm dấu "," thôi, hix

PHP:

=LOOKUP(99^99,--MID(SUBSTITUTE(RIGHT(B5,LEN(B5)-LEN(J5)),","," "),MIN(FIND({0,1,2,3,4,5,6,7,8,9},SUBSTITUTE(RIGHT(B5,LEN(B5)-LEN(J5)),","," ")&"0123456789")),ROW(INDIRECT("1:"&LEN(SUBSTITUTE(RIGHT(B5,LEN(B5)-LEN(J5)),","," "))))))

Cái thứ 3 thì ẹc ẹc...suy nghĩ tiếp, hiiiiiiiiiiii

dhn46 · 10/7/13

hoamattroicoi đã viết:
He he he - cái đầu tiên có thể ngắn chút dhn46 ạ :

PHP:

=--LEFT(B5,COUNT(--LEFT(B5,COLUMN(INDIRECT("1:"&LEN(B5))))))

Cái thứ 2 thì không cần quan tâm chữ "d" vậy, tớ lại quan tâm dấu "," thôi, hix

PHP:

=LOOKUP(99^99,--MID(SUBSTITUTE(RIGHT(B5,LEN(B5)-LEN(J5)),","," "),MIN(FIND({0,1,2,3,4,5,6,7,8,9},SUBSTITUTE(RIGHT(B5,LEN(B5)-LEN(J5)),","," ")&"0123456789")),ROW(INDIRECT("1:"&LEN(SUBSTITUTE(RIGHT(B5,LEN(B5)-LEN(J5)),","," "))))))

Cái thứ 3 thì ẹc ẹc...suy nghĩ tiếp, hiiiiiiiiiiii

Cái thứ 1 của cậu phải Ctrl + Shift + Enter
Cái thứ 2 kết quả phụ thuộc cái thứ nhất 1, không độc lập
----------------------------------------------------
Nếu dữ liệu có cấu trúc như file mẫu thì dùng Reg cũng được

Mã:

Sub Tachso()
Application.ScreenUpdating = False
    Dim ReG As Object, j As Long, i As Long, k As Long
    Set ReG = CreateObject("vbscript.regexp")
    For i = 5 To Range("B65536").End(3).Row
        With ReG
            .Global = True
            .Pattern = "(\d+)\D+(\d+).*[,|\s](\d+).*"
            Cells(i, 3) = .Replace(Cells(i, 2).Value, "$1")
            Cells(i, 4) = .Replace(Cells(i, 2).Value, "$2")
            Cells(i, 5) = .Replace(Cells(i, 2).Value, "$3")
        End With
    Next
Application.ScreenUpdating = True
End Sub

vodoi2x · 10/7/13

hoamattroicoi đã viết:
He he he - cái đầu tiên có thể ngắn chút dhn46 ạ :

PHP:

=--LEFT(B5,COUNT(--LEFT(B5,COLUMN(INDIRECT("1:"&LEN(B5))))))

Cái thứ 2 thì không cần quan tâm chữ "d" vậy, tớ lại quan tâm dấu "," thôi, hix

PHP:

=LOOKUP(99^99,--MID(SUBSTITUTE(RIGHT(B5,LEN(B5)-LEN(J5)),","," "),MIN(FIND({0,1,2,3,4,5,6,7,8,9},SUBSTITUTE(RIGHT(B5,LEN(B5)-LEN(J5)),","," ")&"0123456789")),ROW(INDIRECT("1:"&LEN(SUBSTITUTE(RIGHT(B5,LEN(B5)-LEN(J5)),","," "))))))

Cái thứ 3 thì ẹc ẹc...suy nghĩ tiếp, hiiiiiiiiiiii

Thế thì dùng công thức sau cho cả 3 cái

Chú ý là chuỗi phải đúng quy luật hiện thời, như HD, như B, như T, như d, như @ vvv

thì 3 công thức chơi chơi sau có thể ứng dụng
tất cả đều là công thức thường

ô [C5]

PHP:

=--LEFT(B5,COUNT(INDEX(--LEFT(B5,ROW($1:$255)),0)))

ô [D5]

PHP:

=--TRIM(LEFT(SUBSTITUTE(TRIM(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(UPPER(B5),C5&"D"," ",1),C5&"HD"," ",1),","," "),"A"," "))," ",REPT(" ",255)),255))

ô [E5]

PHP:

=--TRIM(LEFT(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(MID(TRIM(UPPER(B5)),FIND(",",SUBSTITUTE(TRIM(B5)," ",","))+1,255),"B",REPT(" ",255)),"T",REPT(" ",255)),"@",REPT(" ",255)),255))

lâu không động lại công thức thử chém chém chém và chém mấy công thức xem sao

hungpecc1 · 10/7/13

hoamattroicoi đã viết:
Thử code này xem :

PHP:

Sub Tachso() Dim ReG As Object, REMatches, j As Long, i As Long, k As Long Set ReG = CreateObject("vbscript.regexp") For i = 5 To 18 With ReG .Global = True .Pattern = "\d+" Set REMatches = ReG.Execute(Cells(i, 2).Value) End With j = 2 For k = 0 To 2 j = j + 1 Cells(i, j).Value = REMatches(k) Next Next End Sub

Hị hị hị - Xem lại kết quả mẫu thì thấy k có quy luật nào - code phá sản, ẹ ẹ ẹ - chỉ có thể dùng cái này làm trung gian ĐỠ TẠM thôi người ơi, hix hix

*Theo mình nếu đã dùng regexp thì nên viết dưới dạng function cho từng trường hợp.
*Trong hầu hết các dạng 1 str --> trả về kết quả là 1 str : thì có thể không dùng vòng lặp
* Mình hay sử dụng các pattern và phương pháp như sau :
(?! mẫu 1)(mẫu 2) : tìm các chuỗi khớp với mẫu 2 mà phần đầu không có dạng mẫu 1
(mẫu1)(?=mẫu2):tìm các chuỗi khớp với mẫu 1 mà phần sau có dạng mẫu 2
() sử dụng phương pháp Backreference!(phương pháp này thường tốn điện nước ^^)
với dữ liệu bài này, có thể dùng bất kỳ 1 trong 3 phương pháp trên:

Mã:

Function So_Thanh(rng) As Long
    Dim str$, match As Object
        str = CStr(rng)
        With CreateObject("vbscript.regexp")
            .Global = True
            .Pattern = "^\d+(?=D|d|H)"
            If .test(str) Then
                Set match = .Execute(str)
                So_Thanh = CLng(match(0))
            End If
        End With
End Function

Mã:

Function duong_kinh(rng) As Long
    Dim str$, match As Object
        str = CStr(rng)
        With CreateObject("vbscript.regexp")
            .Global = True
            .Pattern = "\d+D(?=\d+)|(?!\d+).+"
            If .test(str) Then
                duong_kinh = CLng(.Replace(str, ""))
            End If
        End With
End Function

Mã:

Function chieu_dai(rng) As Long
    Dim str$, match As Object
        str = CStr(rng)
        With CreateObject("vbscript.regexp")
            .Global = True
            .Pattern = "\w+[,|\s+](\d+).*"
            If .test(str) Then
                chieu_dai = CLng(.Replace(str, "$1"))
            End If
        End With
End Function

dhn46 · 10/7/13

Nếu Function thì mình làm như thế này

Mã:

Function Tach(Str As String, Num As Long)
        With CreateObject("vbscript.Regexp")
            .Global = True
            .Pattern = "(\d+)\D+(\d+).*[,|\s](\d+).*"
            a = "$" & Num
            Tach = .Replace(Str, "$" & Num)
        End With
End Function

Trong đó
Num = 1: Số thanh
Num = 2: Đường kính
Num = 3: Chiều dài

=> Công thức tại C5

Mã:

=tach($B5,COLUMN(A:A))

Kéo sang các ô và dòng còn lại

-----------------------------------------------------------------------------------
Mình góp ý với bài #7
1/ Udf So_Thanh

Mã:

Function So_Thanh(rng) As Long
    Dim str$, match As Object
        str = CStr(rng)
        With CreateObject("vbscript.regexp")
            .Global = True
[B]            .Pattern = "^\d+(?=D|d|H)"[/B]
            If .test(str) Then
                Set match = .Execute(str)
                So_Thanh = CLng(match(0))
            End If
        End With
End Function

Với số thanh chỉ cần lấy đoạn số đầu do đó theo mình chỉ cần \d+ là đủ
2/ Udf duong_kinh

Mã:

Function duong_kinh(rng) As Long
    Dim str$, match As Object
        str = CStr(rng)
        With CreateObject("vbscript.regexp")
            .Global = True
[B]            .Pattern = "\d+D(?=\d+)|(?!\d+).+"[/B]
            If .test(str) Then
                duong_kinh = CLng(.Replace(str, ""))
            End If
        End With
End Function

Sẽ sai khi có trường hợp như ô B16
3/ Udf Chieu_Dai

Mã:

Function chieu_dai(rng) As Long
    Dim str$, match As Object
        str = CStr(rng)
        With CreateObject("vbscript.regexp")
            .Global = True
[B]            .Pattern = "\w+[,|\s+](\d+).*"[/B]
            If .test(str) Then
                chieu_dai = CLng(.Replace(str, "$1"))
            End If
        End With
End Function

Sẽ sai với những trường hợp như ô B16

hungpecc1 · 11/7/13

dhn46 đã viết:
Nếu Function thì mình làm như thế này

Mã:

Function Tach(Str As String, Num As Long) With CreateObject("vbscript.Regexp") .Global = True .Pattern = "(\d+)\D+(\d+).*[,|\s](\d+).*" a = "$" & Num Tach = .Replace(Str, "$" & Num) End With End Function

Trong đó
Num = 1: Số thanh
Num = 2: Đường kính
Num = 3: Chiều dài

=> Công thức tại C5

Mã:

=tach($B5,COLUMN(A:A))

Kéo sang các ô và dòng còn lại

-----------------------------------------------------------------------------------

Đúng là mình nhầm thật, hôm qua buồn ngủ ko xem kỹ đề bài :-=

!

vanduynguyen1983 · 11/7/13

Cảm ơn bạn làm dùm file trên nhưng sao khi mở may mình nó báo lỗi ở cột D cho ra gia tri value chi ra đươc 1 hàng D5 thôi

Tách chuỗi để lấy gia trị số (1 người xem)

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

vanduynguyen1983

Thành viên hoạt động

File đính kèm

hoamattroicoi

Thành viên gắn bó

dhn46

Hướng tới tương lai

hoamattroicoi

Thành viên gắn bó

dhn46

Hướng tới tương lai

File đính kèm

vodoi2x

Nothing & Nothing

hungpecc1

Thành viên gắn bó

dhn46

Hướng tới tương lai

hungpecc1

Thành viên gắn bó

vanduynguyen1983

Thành viên hoạt động

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

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Thời gian đếm ngược.