Rút cụm ký tự từ chuỗi (1 người xem)

Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
Bạn thử cách lấy từ NT4: cho vào ô E4 hàm MID(C4;FIND("NT4";C4;1);3) rồi kéo xuống
 
Let'GâuGâu đã viết:
vba cũng mệt nha, nó một đóng "hăm bà lăng" ko biết khúc nào ráp vô khúc nào.......hihihic...đã thử viế một hơi mệt quá........bỏ..hihihihiih
Nhấp chuột vào đây để mở rộng...

Mình thấy JoinText xơi được đấy nhé (nhưng mà không biết tác giả có chịu VBA hay không)
Ngoài ra thì tin rằng RegEx càng xơi tốt bài này
 
ndu96081631 đã viết:
Mình thấy JoinText xơi được đấy nhé (nhưng mà không biết tác giả có chịu VBA hay không)
Ngoài ra thì tin rằng RegEx càng xơi tốt bài này
Nhấp chuột vào đây để mở rộng...

Em thấy bài này không có quy luật nào cả, bác ra tay 1 phen đi để đàn em được mở rộng tầm mắt.
Hơn nữa bác rất giỏi trong việc sử dụng hàm JoinText
 
phulien1902 đã viết:
Em thấy bài này không có quy luật nào cả, bác ra tay 1 phen đi để đàn em được mở rộng tầm mắt.
Hơn nữa bác rất giỏi trong việc sử dụng hàm JoinText
Nhấp chuột vào đây để mở rộng...

Quy luật người ta nói trong file đó:
mình muốn lấy các tự "ĐX";"NT4";"VT10";"NT101";"NT2122";"NT19";"NT20" chuỗi nào có các cụm ký tự đó thì sẽ lấy ra
Nhấp chuột vào đây để mở rộng...
Chỗ màu đỏ xem như là từ điển. Vậy ta làm như sau:
1> Đặt name
Đặt 1 name có tên là dic, với Refers to:
Mã: 
={"ĐX","NT4","VT10","NT101","NT2122","NT19","NT20"}
2> Code VBA:
Mã: 
Function JoinText(ByVal Delimiter As String, ParamArray Arrays()) As String
  Dim aTmp, arr(), Item, tmp As String
  Dim i As Long, n As Long
  'On Error Resume Next
  For i = LBound(Arrays) To UBound(Arrays)
    aTmp = Arrays(i)
    If Not IsArray(aTmp) Then aTmp = Array(aTmp)
    For Each Item In aTmp
      If TypeName(Item) <> "Error" Then
        tmp = CStr(Item)
        n = n + 1
        ReDim Preserve arr(1 To n)
        arr(n) = tmp
      End If
    Next
  Next
  If n Then JoinText = Join(arr, Delimiter)
End Function
3> Công thức trên Sheet:
Mã: 
=JoinText("",MID(C4,SEARCH(dic,C4),LEN(dic)))
hoặc:
Mã: 
=JoinText("",IF(SEARCH(dic,C4),dic))
Cả 2 công thức đều là mảng, phải Ctrl + Shift + Enter nhé
 
ndu96081631 đã viết:
Quy luật người ta nói trong file đó:

Chỗ màu đỏ xem như là từ điển. Vậy ta làm như sau:
1> Đặt name
Đặt 1 name có tên là dic, với Refers to:
Mã: 
={"ĐX","NT4","VT10","NT101","NT2122","NT19","NT20"}
2> Code VBA:
Mã: 
Function JoinText(ByVal Delimiter As String, ParamArray Arrays()) As String
  Dim aTmp, arr(), Item, tmp As String
  Dim i As Long, n As Long
  'On Error Resume Next
  For i = LBound(Arrays) To UBound(Arrays)
    aTmp = Arrays(i)
    If Not IsArray(aTmp) Then aTmp = Array(aTmp)
    For Each Item In aTmp
      If TypeName(Item) <> "Error" Then
        tmp = CStr(Item)
        n = n + 1
        ReDim Preserve arr(1 To n)
        arr(n) = tmp
      End If
    Next
  Next
  If n Then JoinText = Join(arr, Delimiter)
End Function
3> Công thức trên Sheet:
Mã: 
=JoinText("",MID(C4,SEARCH(dic,C4),LEN(dic)))
hoặc:
Mã: 
=JoinText("",IF(SEARCH(dic,C4),dic))
Cả 2 công thức đều là mảng, phải Ctrl + Shift + Enter nhé
Nhấp chuột vào đây để mở rộng...

Cách làm của anh quá hay rồi, tuy nhiên vẫn có 1 trường hợp( màu vàng) chưa đúng ý của chủ Topic thì phải
 

File đính kèm

phulien1902 đã viết:
Cách làm của anh quá hay rồi, tuy nhiên vẫn có 1 trường hợp( màu vàng) chưa đúng ý của chủ Topic thì phải
Nhấp chuột vào đây để mở rộng...

Cái đó tôi có thấy nhưng JoinText làm việc theo nguyên tắc duyệt các phần tử trong mảng, cái nào nhìn thấy trước thì lấy ra trước
Lưu ý: mảng ở đây chính là các phần tử trong dic (đã đặt name)
---------------
Nếu chủ topic không chịu kết quả này thì các bạn cứ tìm cách khác vậy (RegEx như tôi gợi ý ở trên chẳng hạn)
 
nguyendinhvinh0410 đã viết:
Mình muốn lấy một cụm ký tự bất kỳ từ một chuỗi có sẵn, mong các pro giúp đỡ! (file đính kèm)
Nhấp chuột vào đây để mở rộng...

Em xin thử 1 hàm sau

PHP: 
Public Function TachChuoi(ByVal ChuoiTim As String, ByVal ChuoiChuan As Range) As String
Dim Arr, i As Byte
Arr = ChuoiChuan
For i = 1 To UBound(Arr, 1)
    If Len(TachChuoi) = 0 Then
        If InStr(1, ChuoiTim, Arr(i, 1)) Then TachChuoi = Arr(i, 1)
    ElseIf InStr(1, ChuoiTim, Arr(i, 1)) Then
        If InStr(1, ChuoiTim, TachChuoi & Arr(i, 1)) Then
            TachChuoi = TachChuoi & Arr(i, 1)
        Else
            TachChuoi = Arr(i, 1) & TachChuoi
        End If
    End If
Next i
End Function
 

File đính kèm

ndu96081631 đã viết:
Cái đó tôi có thấy nhưng JoinText làm việc theo nguyên tắc duyệt các phần tử trong mảng, cái nào nhìn thấy trước thì lấy ra trước
Lưu ý: mảng ở đây chính là các phần tử trong dic (đã đặt name)
---------------
Nếu chủ topic không chịu kết quả này thì các bạn cứ tìm cách khác vậy (RegEx như tôi gợi ý ở trên chẳng hạn)
Nhấp chuột vào đây để mở rộng...
Tình cờ đọc được tài liệu hướng dẫn sử dụng RegEx sực nhớ đến bài gợi ý của thầy nên em áp dụng luôn. Lâu lâu không thấy thấy ol thấy nhớ quá.
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 arr(i) <> "NT1" Then
            Rut = Rut & arr(i)
            Rut = Replace(Rut, "D", ChrW(272), 1, 1)
        End If
    Next
End Function[COLOR=#000000]
 

File đính kèm

Lần chỉnh sửa cuối:
doatmenhhon đã viết:
Tình cờ đọc được tài liệu hướng dẫn sử dụng RegEx sực nhớ đến bài gợi ý của thầy nên em áp dụng luôn. Lâu lâu không thấy thấy ol thấy nhớ quá.
Code:
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 arr(i) <> "NT1" Then
Rut = Rut & arr(i)
Rut = Replace(Rut, "D", ChrW(272), 1, 1)
End If
Next
End Function
Nhấp chuột vào đây để mở rộng...

Pattern sai rồi.
Rut("1_1HH_ĐXNT4-47-1") = "HHĐXNT4" ---> HH không phải là ký tự muốn lấy
 
Ngó cái pattern thì biết nó sai rồi. Ví dụ chỉ là chứng minh.

tb. đừng có ka kiếc với tôi. Tôi không dùng ngôn ngữ giang hồ.
 
VetMini đã viết:
Ngó cái pattern thì biết nó sai rồi. Ví dụ chỉ là chứng minh.

tb. đừng có ka kiếc với tôi. Tôi không dùng ngôn ngữ giang hồ.
Nhấp chuột vào đây để mở rộng...
Thế sư huynh phải gặp Huuthang_bd yêu cầu đến đâu thì làm đến đấy không có chuyện dùng xô thay ly để uống nước. Ha ha
 
VetMini đã viết:
Ngó cái pattern thì biết nó sai rồi. Ví dụ chỉ là chứng minh.

tb. đừng có ka kiếc với tôi. Tôi không dùng ngôn ngữ giang hồ.
Nhấp chuột vào đây để mở rộng...

cái pattern hoang đường như này
Mã: 
.Pattern = "[A-Z]{2}[0-9]{0,4}"
mà cũng dám đưa vào code để xài , người khác góp ý có vẻ không "ăn lời" , chắc không giao lưu tiếp được rồi
 
doveandrose đã viết:
cái pattern hoang đường như này
Mã: 
.Pattern = "[A-Z]{2}[0-9]{0,4}"
mà cũng dám đưa vào code để xài , người khác góp ý có vẻ không "ăn lời" , chắc không giao lưu tiếp được rồi
Nhấp chuột vào đây để mở rộng...
Vậy Pattern đúng ở đây là gì vậy "chàng". "Thiếp" muốn nghe góp ý của "chàng".
 
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 ^^
 
VetMini đã viết:
Mệt với nghề tét code của bạn quá.

Xtract("1_1H_ĐXNT4-47-1", "ĐX;NT4;VT10;NT101;NT2122;NT19;NT20") = "ĐXNT4"[TABLE="width: 64"]
[TR]
[TD="width: 64"][/TD]
[/TR]
[/TABLE]
Nhấp chuột vào đây để mở rộng...
Đang làm việc vì cái vụ cót két của bạn mà từ nãy cứ phải dập dòm vào hóng đấy ^^
 
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.
 
giangleloi đã viết:
Code đó có vấn đề hay không là do bạn đấy? Tôi cũng đọc nhiều bài viết của VetMini, nếu đã viết thì đa số các bài viết đều tỉ mỉ cả.
Nhấp chuột vào đây để mở rộng...
Cho thế này thì được =xtract(A1; "NT4;VT10;NT101;NT2122;NT19;NT20;ĐX"). Chắc cái máy củ chuối nó thế chuyển đi chuyển lại tự nhiên được
 
Lần chỉnh sửa cuối:
hình nhỏ xíu, để xem lại. Làm cách nào để gỡ hình ra nhỉ?

Sửa: Cám ơn D&R. Mây cái hình nhỏ xíu, chả nhìn được gì cả,đã gỡ rồi.
 
Lần chỉnh sửa cuối:
VetMini đã viết:
Mệt nhỉ. Với một người viết code như bạn thì có gì khó đâu


View attachment 150112
Nhấp chuột vào đây để mở rộng...
Thứ nhất là không có time đang làm việc hăng say vì có code hay nên cố hóng. Thứ hai máy móc nhiều khi nó giở trời lúc nẫy để ĐX ở đầu nó không được tính để về nhà theo dõi xem sao nhưng trót hỏi rồi thì hỏi cho trót.
 
VetMini đã viết:
hình nhỏ xíu, để xem lại. Làm cách nào để gỡ hình ra nhỉ?
Nhấp chuột vào đây để mở rộng...
í cái này em biết nè
khi bấm vài nút tải File thì cửa sổ chọn File hiện ra , ta kéo xuống 1 chút thì thấy các file đã tải của mình

95697562f4835a0abd9ee477d67d82ae.png


giờ muốn bỏ cái nào thì bấm vào nút Remove bên cạnh File đó . hi hi
 

File đính kèm

  • Untitled.jpg
    Untitled.jpg
    17 KB · Đọc: 65
ndu96081631 đã viết:
Quy luật người ta nói trong file đó:

Chỗ màu đỏ xem như là từ điển. Vậy ta làm như sau:
1> Đặt name
Đặt 1 name có tên là dic, với Refers to:
Mã: 
={"ĐX","NT4","VT10","NT101","NT2122","NT19","NT20"}
2> Code VBA:
Mã: 
Function JoinText(ByVal Delimiter As String, ParamArray Arrays()) As String
  Dim aTmp, arr(), Item, tmp As String
  Dim i As Long, n As Long
  'On Error Resume Next
  For i = LBound(Arrays) To UBound(Arrays)
    aTmp = Arrays(i)
    If Not IsArray(aTmp) Then aTmp = Array(aTmp)
    For Each Item In aTmp
      If TypeName(Item) <> "Error" Then
        tmp = CStr(Item)
        n = n + 1
        ReDim Preserve arr(1 To n)
        arr(n) = tmp
      End If
    Next
  Next
  If n Then JoinText = Join(arr, Delimiter)
End Function
3> Công thức trên Sheet:
Mã: 
=JoinText("",MID(C4,SEARCH(dic,C4),LEN(dic)))
hoặc:
Mã: 
=JoinText("",IF(SEARCH(dic,C4),dic))
Cả 2 công thức đều là mảng, phải Ctrl + Shift + Enter nhé
Nhấp chuột vào đây để mở rộng...
Cảm ơn anh về bài viết này. Đúng là em cũng đang có thắc mắc giống vậy.
Anh cho em hỏi thêm chút em nhận được file có 64652 dòng thông tin, trong đó có tên, địa chỉ... Khổ nỗi người nhập liệu trước kia nhập theo 2 kiểu cả TCVN và Unicode (font .VnTime và Arial) và rất lộn xộn. Em đã thử bôi đen từng cột rồi đổi font từ UniKey nhưng không hoàn chỉnh do nó bị nhảy dòng (khi đổi xong em paste lại nó lại hơn 64652 dòng, mỗi cột lại thêm ra số dòng khác nhau).
Anh có cách nào khắc phục có thể chỉ giúp cho em được không?
Em cảm ơn anh ạ.
 
van_utc đã viết:
Cảm ơn anh về bài viết này. Đúng là em cũng đang có thắc mắc giống vậy.
Anh cho em hỏi thêm chút em nhận được file có 64652 dòng thông tin, trong đó có tên, địa chỉ... Khổ nỗi người nhập liệu trước kia nhập theo 2 kiểu cả TCVN và Unicode (font .VnTime và Arial) và rất lộn xộn. Em đã thử bôi đen từng cột rồi đổi font từ UniKey nhưng không hoàn chỉnh do nó bị nhảy dòng (khi đổi xong em paste lại nó lại hơn 64652 dòng, mỗi cột lại thêm ra số dòng khác nhau).
Anh có cách nào khắc phục có thể chỉ giúp cho em được không?
Em cảm ơn anh ạ.
Nhấp chuột vào đây để mở rộng...
Bạn chịu khó chờ đến tết Công Gô ^^
 
van_utc đã viết:
Cảm ơn anh về bài viết này. Đúng là em cũng đang có thắc mắc giống vậy.
Anh cho em hỏi thêm chút em nhận được file có 64652 dòng thông tin, trong đó có tên, địa chỉ... Khổ nỗi người nhập liệu trước kia nhập theo 2 kiểu cả TCVN và Unicode (font .VnTime và Arial) và rất lộn xộn. Em đã thử bôi đen từng cột rồi đổi font từ UniKey nhưng không hoàn chỉnh do nó bị nhảy dòng (khi đổi xong em paste lại nó lại hơn 64652 dòng, mỗi cột lại thêm ra số dòng khác nhau).
Anh có cách nào khắc phục có thể chỉ giúp cho em được không?
Em cảm ơn anh ạ.
Nhấp chuột vào đây để mở rộng...
Cái này có thể dùng font.name lọc ra, sau đó dùng công cụ của unikey xử lý
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

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

dungluyen2119
  • Question Question
Code VBA để tính tổng theo chiều ngang mà số cột không cố định (2 người xem)
Trả lời
4
Đọc
40
HUONGHCKT
H
D
Lọc cột chứa nhiều nhóm từ trong Excel. Mong các bạn giải đáp giúp (2 người xem)
Trả lời
7
Đọc
108
ptm0412
ptm0412
V
  • Question Question
Nhờ mọi người giúp cách xóa các mục đã chọn trong Droplist của một nhóm các ô cùng dạy một môn học.
Trả lời
2
Đọc
154
vinhphtdp
V
H
Câu lệnh mở file Excel trong Macbook Pro 1 (1 người xem)
Trả lời
0
Đọc
15
huafu_Jackl
H
N
Tạo COM Add-In bằng Visual C++ (1 người xem)
    • Thích
Trả lời
8
Đọc
739
nguyendang95
N
PhanTuHuong
Chương trình lập Báo cáo khảo sát Địa chất công trình GeoSection
    • Thích
Trả lời
8
Đọc
6K
PhanTuHuong
PhanTuHuong
V
  • Question Question
Xác định xu hướng cấp 1,2,3
Trả lời
0
Đọc
24
vuthienfx
V
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
    • Cảm ơn
2 3 4
Trả lời
384
Đọc
45K
thanhluan0912
T
Nguyễn Duy Tuân
  • Question Question
AI muốn lập trình DLL cho Excel và các loại bằng Delphi thì xem video này nhé! (3 người xem)
    • Thích
    • Yêu thích
13 14 15
Trả lời
1K
Đọc
198K
Nguyễn Duy Tuân
Nguyễn Duy Tuân
K
Tạo sheet tổng hợp
    • Cười
Trả lời
7
Đọc
314
SA_DQ
SA_DQ
V
Công thức để phân công chuyên môn cho giáo viên
Trả lời
9
Đọc
352
Hoàng Tuấn 868
H
Gà Con yêu VBA
Mở Pass file excel phiên bản .xlsx , xlsm, xlsb (1 người xem)
Trả lời
4
Đọc
125
befaint
befaint
V
  • Question Question
xác định xu hướng
Trả lời
3
Đọc
132
vuthienfx
V
giaiphap
Lập trình C# tạo Add-ins cho excel.
    • Thích
Trả lời
52
Đọc
8K
nguyendang95
N
OverAC
  • Dán lên cao
  • Suggestion Suggestion
Chúc mừng sinh nhật GiaiPhapExcel 19 tuổi và tặng ebook "Lập trình VBA phần cơ bản."
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
7
Đọc
1K
PhanTuHuong
PhanTuHuong
Y
Lấy dữ liệu từ sheet chi tiết sang sheet tổng hợp hàng dọc
Trả lời
6
Đọc
588
yoomi
Y
E
Đánh số cho các cặp số chứng từ và số chứng từ đối ứng
Trả lời
16
Đọc
414
Phan Thế Hiệp
Phan Thế Hiệp
N
Hàm tính chuỗi số trong 1 ô hoặc 1 dãy ô ra tổng kết quả.
Trả lời
2
Đọc
124
minhminh27
minhminh27
NguyenthiH
Mở file Excel có Pass Open (2 người xem)
Trả lời
39
Đọc
3K
Hoàng Tuấn 868
H
M
Tách dữ liệu trong 1 file thành nhiều sheet theo số lượng dòng
    • Ngạc nhiên
Trả lời
25
Đọc
3K
Hoàng Tuấn 868
H
Xem thêm…

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.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom