Rút cụm ký tự từ chuỗi

Liên hệ QC
doveandrose đã viết:
đơn giản : không biết . Lêu lêu (khi nào chủ topic nêu đích danh : mời Doveandrose viết giúp đoạn code thì đó là chuyện khác =)))
Nhấp chuột vào đây để mở rộng...
Hihi nếu chặt ra thì thêm if left(arr(i), 2) =”DX” or left(arr(i), 2) =”NT” or left(arr(i), 2) = "VT" or left(arr(i), 3) <> "NT1" ....nhưng làm biếng ^^. Thậm chí có thể tạo ra một darr = array( "DX1, "VT10"...) để Instr. Thứ tự trong chuỗi không bao giờ bị đảo ngược tùy theo vị trí xuất hiện. Partern là định dạng thô, còn muốn định dạng tinh thì dùng if với instr. Partern của mình chuẩn VetMini là một bạn đanh đá
 
Lần chỉnh sửa cuối:
doatmenhhon đã viết:
Hihi nếu chặt ra thì thêm if left(arr(i), 2) =”DX” or left(arr(i), 2) =”NT” or left(arr(i), 2) = "VT" or left(arr(i), 3) <> "NT1" ....nhưng làm biếng ^^. Thậm chí có thể tạo ra một darr = array( "DX1, "VT10"...) để Instr. Thứ tự trong chuỗi không bao giờ bị đảo ngược tùy theo vị trí xuất hiện. Partern là định dạng thô, còn muốn định dạng tinh thì dùng if với instr. Partern của mình chuẩn VetMini là một bạn đanh đá
Nhấp chuột vào đây để mở rộng...

Học Regex chưa tinh, đừng có phán bừa bãi.
Tôi không thích cái giọng giang hồ huynh huynh đệ đệ cho nên không muốn phí sức.
Tôi chỉ cảnh báo cho các bạn khác muốn học hỏi là cái pattren kia sai tét bét thôi. Sai từ căn bản đến cách áp dụng.
 
VetMini đã viết:
Học Regex chưa tinh, đừng có phán bừa bãi.
Tôi không thích cái giọng giang hồ huynh huynh đệ đệ cho nên không muốn phí sức.
Tôi chỉ cảnh báo cho các bạn khác muốn học hỏi là cái pattren kia sai tét bét thôi. Sai từ căn bản đến cách áp dụng.
Nhấp chuột vào đây để mở rộng...
Tôi không hề nghĩ nó sai. Chẳng qua là cách sử dụng và mục đích sử dụng. Tôi nghĩ trong nhiều trường hợp cách nghĩ của bạn rất cứng. Hãy thử với code:
Mã: 
[/COLOR]Function Rut(ByVal ref As String) As String
    Dim rx As Object, arr As Object, i As Integer
     ref = Replace(ref, ChrW(272), "D", 1, 1)
    Set rx = CreateObject("VBscript.Regexp")
    With rx
        .Pattern = "[A-Z]{2}[0-9]{0,4}"
        .Global = True
        If .test(ref) Then Set arr = .Execute(ref)
    End With
    For i = 0 To arr.Count - 1
        If Left(arr(i), 2) = "NT" Or Left(arr(i), 2) = "DX" Or Left(arr(i), 2) = "VT" Then
            If arr(i) <> "NT1" Then
                Rut = Rut & arr(i)
                Rut = Replace(Rut, "D", ChrW(272), 1, 1)
            End If
        End If
    Next
End Function[COLOR=#000000]
 
Lần chỉnh sửa cuối:
Dùng Regex đôi khi vẫn phải tét lại một vài trường hợp ngoại lệ. Điều này không thể chối cãi.
Nhưng trường hợp bài này không phức tạp lắm. Một vài patterns regex có thể giải quyết được.
Dạng bài nay mà phải dùng tùm lum IF-THEN-ELSE là tại chưa biết cách chế pattern.

Tôi không hề nghĩ nó sai. Chẳng qua là cách sử dụng và mục đích sử dụng
Nhấp chuột vào đây để mở rộng...

Dữ liệu ví dụ chính chắn, không có gì đặc biệt. Nếu hàm cho ra kết quả không như ý muốn là code sai. Chân lý nó vậy.
Nếu muốn nói chuyện "cách sử dụng và mục đích sử dụng" thì những điều đó phải ghi rõ trong chú thích (comments) của code. Baats cứ người nào lập trình cũng đều biết đó là một trong những mục đích của chú thích.
 
VetMini đã viết:
Dùng Regex đôi khi vẫn phải tét lại một vài trường hợp ngoại lệ. Điều này không thể chối cãi.
Nhưng trường hợp bài này không phức tạp lắm. Một vài patterns regex có thể giải quyết được.
Dạng bài nay mà phải dùng tùm lum IF-THEN-ELSE là tại chưa biết cách chế pattern.
Dữ liệu ví dụ chính chắn, không có gì đặc biệt. Nếu hàm cho ra kết quả không như ý muốn là code sai. Chân lý nó vậy.
Nếu muốn nói chuyện "cách sử dụng và mục đích sử dụng" thì những điều đó phải ghi rõ trong chú thích (comments) của code. Baats cứ người nào lập trình cũng đều biết đó là một trong những mục đích của chú thích.
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn đã quan tâm nhưng trên diễn đàn nhiều khi bạn cũng đanh đá quá cơ. Thực ra anh Bill chưa bảo sai mà bạn bảo Pattern sai là tôi hơi giật mình. Đôi khi tùy theo dữ liệu thật mà tùy biến có người cẩn thận thì suy nghĩ tỉ mỉ đến từng con kiến, đêm nằm còn giật thon thót. Với tôi viết vừa đủ tầm, rồi tương tác nhiều với dữ liệu sẽ rút ra một qui luật nó ít nhất là về mặt qui luật thống kê mà chỉnh code. Nếu bạn muốn chặt nữa thì hãy Instr mảng arr(i) với mảng array như tôi gợi ý. Thân.
 
Ở diễn đàn này, ai cũng biết tôi nói chuyện không kính nể với những người dùng lối xưng hô tiếng Tây hoăch tiếng ngôn ngữ game. Bạn khỏi cần phải nhắc nhở tôi về việc "đanh đá" hay chua ngoa gì cả.

Tôi đã mách nước là nếu viết đúng pattern thì vẫn có thể giải quyết được bài. Bạn cứ mãi nói chuyện InStr với mảng array?

Và ở diễn đàn này ai cũng rõ tính tôi chỉ viết code cho xem thử nếu có bạn nào có nhu cầu học hỏi. Nếu cho là việc này không quan trọng thì tôi phí sức làm gì.
 
Góp 1 cách
Mã: 
Function Tach(Ref As String) As String
Ref = Replace(Left(Replace(Ref & "_", "NT1_", "-"), _
InStr(Replace(Ref & "_", "NT1_", "-"), "-") - 1), "_", "a00")

With CreateObject("vbscript.regexp")
.Pattern = ".+[a-z]\d{2}"
Tach = .Replace(Ref, "")
End With
End Function
 
VetMini đã viết:
Ở diễn đàn này, ai cũng biết tôi nói chuyện không kính nể với những người dùng lối xưng hô tiếng Tây hoăch tiếng ngôn ngữ game. Bạn khỏi cần phải nhắc nhở tôi về việc "đanh đá" hay chua ngoa gì cả.

Tôi đã mách nước là nếu viết đúng pattern thì vẫn có thể giải quyết được bài. Bạn cứ mãi nói chuyện InStr với mảng array?

Và ở diễn đàn này ai cũng rõ tính tôi chỉ viết code cho xem thử nếu có bạn nào có nhu cầu học hỏi. Nếu cho là việc này không quan trọng thì tôi phí sức làm gì.
Nhấp chuột vào đây để mở rộng...
Tôi biết vậy nên cũng vẫn đang nghĩ cách và tính tôi đã quyết sẽ làm bằng được ^^
 
Lần chỉnh sửa cuối:
gtri đã viết:
Góp 1 cách
Mã: 
Function Tach(Ref As String) As String
Ref = Replace(Left(Replace(Ref & "_", "NT1_", "-"), _
InStr(Replace(Ref & "_", "NT1_", "-"), "-") - 1), "_", "a00")

With CreateObject("vbscript.regexp")
.Pattern = ".+[a-z]\d{2}"
Tach = .Replace(Ref, "")
End With
End Function
Nhấp chuột vào đây để mở rộng...

Pattern của bạn matches tất cả các dạng số đi sau 2 ký tự. Ví dụ gặo VT20 thì nó cũng lụm luôn.
Tôi không chối cãi có khả năng đó là cái cuối cùng chủ thớt muốn. Nhưng theo cách diễn tả trong file thì ta chỉ match đúng những cụm từ "ĐX;NT4;VT10;NT101;NT2122;NT19;NT20" thôi.
Chuyện chủ thớt diến tả không rõ là chuyện bình thường. Ngay cả ví dụ của chủ thớt cũng sai. Cái chuỗi cuó cùng là "213_2H_h03NT19NT1" thế mà kết quả ra "NT20"

Đề nghị: bạn thử dùng chiến thuật dòm trước - (negative) lookahead xem sao?
Đùa với Regex phải trải qua dòm trước ngó sau mới đắc đạo.
 
Lần chỉnh sửa cuối:
.Pattern = "(NT4|VT10|NT101|NT2122|NT19|DX)" thế này hả bạn Vetmini Hihi
 
VetMini đã viết:
Ở diễn đàn này, ai cũng biết tôi nói chuyện không kính nể với những người dùng lối xưng hô tiếng Tây hoăch tiếng ngôn ngữ game. Bạn khỏi cần phải nhắc nhở tôi về việc "đanh đá" hay chua ngoa gì cả.

Tôi đã mách nước là nếu viết đúng pattern thì vẫn có thể giải quyết được bài. Bạn cứ mãi nói chuyện InStr với mảng array?

Và ở diễn đàn này ai cũng rõ tính tôi chỉ viết code cho xem thử nếu có bạn nào có nhu cầu học hỏi. Nếu cho là việc này không quan trọng thì tôi phí sức làm gì.
Nhấp chuột vào đây để mở rộng...
Mình xin sửa lại code thành
Mã: 
[/COLOR]Function Rut(ByVal ref As String) As String
    Dim rx As Object, arr As Object, i As Integer
     ref = Replace(ref, ChrW(272), "D", 1, 1)
    Set rx = CreateObject("VBscript.Regexp")
    With rx
        .Pattern = "(NT4|VT10|NT101|NT2122|NT19|DX)"
        .Global = True
        If .Test(ref) Then Set arr = .Execute(ref)
    End With
    For i = 0 To arr.Count - 1
            Rut = Rut & arr(i)
            Rut = Replace(Rut, "D", ChrW(272), 1, 1)
    Next
End Function[COLOR=#000000]
 
Lần chỉnh sửa cuối:
doatmenhhon đã viết:
Mình xin sửa lại code thành
Function Rut(ByVal ref As String) As String
Dim rx As Object, arr As Object, i As Integer
ref = Replace(ref, ChrW(272), "D", 1, 1)
Set rx = CreateObject("VBscript.Regexp")
With rx
.Pattern = "(NT4|VT10|NT101|NT2122|NT19|DX)"
.Global = True
If .Test(ref) Then Set arr = .Execute(ref)
End With
For i = 0 To arr.Count - 1
Rut = Rut & arr(i)
Rut = Replace(Rut, "D", ChrW(272), 1, 1)
Next
End Function
Nhấp chuột vào đây để mở rộng...

Cái pattern chỉ đúng nếu theo đề bài gặp NT41 thì cũng lấy luôn phần NT4
Nếu muốn loại NT41 thì phải dùng kỹ thuật lookahead

Code hàm chưa hoàn hảo.
1. Gặp DX thì nó cũng lấy luôn, và cho ra ĐX
2. Nếu không tìm được thì nó cho ra #VALUE!. Loại bài này, nếu mẫu tìm không có thì phải trả về rỗng ""
 
VetMini đã viết:
Đề nghị: bạn thử dùng chiến thuật dòm trước - (negative) lookahead xem sao?
Nhấp chuột vào đây để mở rộng...

Tìm được cái này nhưng không rút ngắn pattern được nữa
Mã: 
Function Tach(Ref As String) As String
Ref = Replace(Ref & "_", "NT1_", "-")

With CreateObject("vbscript.regexp")
.Pattern = "\W*[A-Z][^_-]*(?=-)"
Tach = .Execute(Ref)(0)
End With
End Function
 
VetMini đã viết:
Cái pattern chỉ đúng nếu theo đề bài gặp NT41 thì cũng lấy luôn phần NT4
Nếu muốn loại NT41 thì phải dùng kỹ thuật lookahead

Code hàm chưa hoàn hảo.
1. Gặp DX thì nó cũng lấy luôn, và cho ra ĐX
2. Nếu không tìm được thì nó cho ra #VALUE!. Loại bài này, nếu mẫu tìm không có thì phải trả về rỗng ""
Nhấp chuột vào đây để mở rộng...
Tiếp tục suy nghĩ --=0--=0--=0
 
gtri đã viết:
Tìm được cái này nhưng không rút ngắn pattern được nữa
Mã: 
Function Tach(Ref As String) As String
Ref = Replace(Ref & "_", "NT1_", "-")

With CreateObject("vbscript.regexp")
.Pattern = "\W*[A-Z][^_-]*(?=-)"
Tach = .Execute(Ref)(0)
End With
End Function
Nhấp chuột vào đây để mở rộng...

Thông thưởng, RegEx chỉ cần cho nó đừng "tham lam", ngốn ký tự của chuỗi nó duyệt nhiều quá. Chứ chính nó dài ngắn không quan trọng lắm.

Bài này có hể dùng negative lookahead để bảo pattern làm việc chính xác hơn. Ví dụ dể chọn NT4 trong NT4NT1 nhưng không chọn trong NT41NT1 thì bạn có thể giới hạn nó là NT4(?![\d]) --> thấy NT4 rồi, nhưng còn phải dòm trước, nếu sau NT4 mà có ký tự số thì không đạt

Code đại khái như vầy:
Mã: 
Public Function Xtract(ByVal s As String, ByVal pat As String, Optional ByVal dlim As String = ";")
[COLOR=#008000]' hàm tìm trong chuỗi s, lấy những chuỗi con trong pat
' chuõi con được mặc định dấu ngăn là chấm phẩy ;
' cách sử dụng =Xtract(C4, "ĐX;NT4;VT10;NT101;NT2122;NT19;NT20")[/COLOR]
Dim RE As Object
Set RE = CreateObject("vbscript.regexp")
RE.Global = True
RE.Pattern = ""
RE.IgnoreCase = True

[COLOR=#008000]' lưu ý, nếu chuõi NT4 lặp lại nhiều lần trong chuỗi thì kết quả cũng lặp lại bấy nhiêu lần
' nếu muốn chỉ trả về 1 lần thì phải dùng vòng lặp match từng mẫu một, và chỉ lấy ta matchcollection(0)
[/COLOR]Dim itm As Variant
For Each itm In Split(pat, dlim)
RE.Pattern = RE.Pattern & IIf(RE.Pattern = "", "", "|") & itm & IIf(IsNumeric(Right(itm, 1)), "(?![\d])", "")
Next
Xtract = "" [COLOR=#008000]' nếu không có dòng này, trị của Xtract được mặc định là rỗng, khi không có match, ô worksheet sẽ ghi trị là 0[/COLOR]
For Each itm In RE.Execute(s)
Xtract = Xtract & itm
Next
End Function

Lưu ý: code chỉ dùng để ví dụ. Trên thực tế, nếu viết hàm dùng cho worksheet thì phải giữ Ọbject RegExp lại. Chả nhẽ khi kéo hàm fill xuống, mỗi con tính lại phải dựng lại Object này? Cách thông thường nhất là khai báo nó dạng biến static.
 
Lần chỉnh sửa cuối:
VetMini đã viết:
Thông thưởng, RegEx chỉ cần cho nó đừng "tham lam", ngốn ký tự của chuỗi nó duyệt nhiều quá. Chứ chính nó dài ngắn không quan trọng lắm.

Bài này có hể dùng negative lookahead để bảo pattern làm việc chính xác hơn. Ví dụ dể chọn NT4 trong NT4NT1 nhưng không chọn trong NT41NT1 thì bạn có thể giới hạn nó laf NT4(?![\d]) --> nếu sau NT4 mà có ký tự số thì không đạt

Code đại khái như vầy:
Mã: 
Public Function Xtract(ByVal s As String, ByVal pat As String, Optional ByVal dlim As String = ";")
[COLOR=#008000]' hàm tìm trong chuỗi s, lấy những chuỗi con trong pat
' chuõi con được mặc định dấu ngăn là chấm phẩy ;
' cách sử dụng =Xtract(C4, "ĐX;NT4;VT10;NT101;NT2122;NT19;NT20")[/COLOR]
Dim RE As Object
Set RE = CreateObject("vbscript.regexp")
RE.Global = True
RE.Pattern = ""
RE.IgnoreCase = True

[COLOR=#008000]' lưu ý, nếu chuõi NT4 lặp lại nhiều lần trong chuỗi thì kết quả cũng lặp lại bấy nhiêu lần
' nếu muốn chỉ trả về 1 lần thì phải dùng vòng lặp match từng mẫu một, và chỉ lấy ta matchcollection(0)
[/COLOR]Dim itm As Variant
For Each el In Split(pat, dlim)
RE.Pattern = RE.Pattern & IIf(RE.Pattern = "", "", "|") & el & IIf(IsNumeric(Right(el, 1)), "(?![\d])", "")
Next
Xtract = "" [COLOR=#008000]' nếu không có dòng này, trị của Xtract được mặc định là rỗng, khi không có match, ô worksheet sẽ ghi trị là 0[/COLOR]
For Each itm In RE.Execute(s)
Xtract = Xtract & itm
Next
End Function

Lưu ý: code chỉ dùng để ví dụ. Trên thực tế, nếu viết hàm dùng cho worksheet thì phải giữ Ọbject RegExp lại. Chả nhẽ khi kéo hàm fill xuống, mỗi con tính lại phải dựng lại Object này? Cách thông thường nhất là khai báo nó dạng biến static.
Nhấp chuột vào đây để mở rộng...
Code này không thấy rút được ĐX ^^
 
Người biết tét code chỉ việc vào cửa sổ immediate gõ ? hàm(tham số) là ra thôi
Đầu hàm có ghi rõ cách sử dụng mà không chịu đọc. Tại bạn viết code ít chịu chú cho nên nghĩ rằng ai cũng như vậy.
 
VetMini đã viết:
Người biết tét code chỉ việc vào cửa sổ immediate gõ ? hàm(tham số) là ra thôi
Đầu hàm có ghi rõ cách sử dụng mà không chịu đọc. Tại bạn viết code ít chịu chú cho nên nghĩ rằng ai cũng như vậy.
Nhấp chuột vào đây để mở rộng...
Mình làm theo hướng dẫn rồi đấy chứ bạn xem lại xem. Từ nãy bận cũng chưa check lại được.
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

hongphuong1997
Tắt máy không cho người khác dùng
2
Trả lời
24
Đọc
260
huhumalu
H
K
muốn coppy hàm HLOOKUP và tự động thay đổi giá trị
Trả lời
1
Đọc
8
HieuCD
H
hung2412
  • Question
Có cách nào nạp một loạt giá trị Name (Name trong Name Manager) vào các Biến tương ứng trong VBA hay không?
2
Trả lời
32
Đọc
656
ptm0412
ptm0412
K
sử dụng hàm SUMPRODUCT để chia giữa 2 cột với nhau
Trả lời
1
Đọc
22
neyugngnort
neyugngnort
T
  • Question
Lỗi "Out of memory" khi khai báo kích thước mảng
2
Trả lời
30
Đọc
450
huuthang_bd
huuthang_bd
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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

Back
Top Bottom