Viết Hàm tách Chuỗi ký dựa trên DATA cho trước

Blue Softs Liên hệ QC

Ldh1984

Thành viên mới
Tham gia
18/7/21
Bài viết
26
Được thích
3
Mình có file bên dưới và có đoạn code viết như thế này để tách lấy chuỗi ký tự trong vùng dữ liệu, mình đã áp dụng và làm ok :) "nhưng bất cập ở chổ tính toán của đoạn code này nếu dòng dữ liệu lên đến 1000 dòng thì mức độ tính toán của code này khá lâu làm mất rất nhiều thời gian. kính mong các cao nhân trợ giúp đoạn code để giảm bớt thời gian trong vấn đề lấy dữ liệu, xin cảm ơn!
Code VBA 1: lấy đoạn mã 7 ký tự gồm chữ và số
Function HE_FIND7(A As Range, B As Range) As Variant
Dim ai As Range
Dim bi As Range
Dim i As Integer
For Each bi In B
For Each ai In A
'For Each ci In C
For i = 1 To Len(bi.Value)
If Mid(bi.Value, i, 7) = ai.Value Then
HE_FIND7 = ai.Value
' MsgBox "hh"
Exit Function
End If
Next i
'next ci
Next ai
Next bi

End Function

Code VBA 2: lấy đoạn mã 10 ký tự gồm chữ và số
Function HE_FIND10(A As Range, B As Range) As Variant
Dim ai As Range
Dim bi As Range
Dim i As Integer
For Each bi In B
For Each ai In A
'For Each ci In C
For i = 1 To Len(bi.Value)
If Mid(bi.Value, i, 10) = ai.Value Then
HE_FIND10 = ai.Value
' MsgBox "hh"
Exit Function
End If
Next i
'next ci
Next ai
Next bi

End Function
 

File đính kèm

  • Book1.xlsm
    16.1 KB · Đọc: 25

Phuocam

Thành viên mới
Tham gia
16/5/13
Bài viết
3,472
Được thích
4,946
Donate (Momo)
Donate
Mình có file bên dưới và có đoạn code viết như thế này để tách lấy chuỗi ký tự trong vùng dữ liệu, mình đã áp dụng và làm ok :) "nhưng bất cập ở chổ tính toán của đoạn code này nếu dòng dữ liệu lên đến 1000 dòng thì mức độ tính toán của code này khá lâu làm mất rất nhiều thời gian. kính mong các cao nhân trợ giúp đoạn code để giảm bớt thời gian trong vấn đề lấy dữ liệu, xin cảm ơn!
Bạn thử dùng UDF sau:
PHP:
Function GetID(RngData As Range, txt As String) As String
Dim arrData, v As Variant
arrData = RngData.Value
txt = " " & Replace(txt, "+", " ") & " "
    For Each v In arrData
        If InStr(1, txt, " " & v & " ") > 0 Then
            GetID = v
            Exit For
        End If
    Next v
End Function
Cách sử dụng:

=GetID($B$4:$B$9,D4)

.
 
Upvote 0

VetMini

Chuyên gia GPE
Tham gia
21/12/12
Bài viết
12,176
Được thích
15,616
Bài này là kinh điển của phương thức Find.

Function HE_FIND_N(A As Range, B As Range, N As Long) As Variant
' tham số thứ ba là số ký tự cần lấy (7 hoặc 10)
For Each c In A
If Len(c.Value) = N Then ' chỉ cần xét những giá trị có đúng độ dài
If Not B.Find(What:=c.Value, LookIn:=xlValues, LookAt:=xlPart) Is Nothing Then
HE_FIND_N = c.Value
Exit Function
End If
End If
Next ca
End Function
 
Upvote 0

batman1

Thành viên gạo cội
Tham gia
8/9/14
Bài viết
4,648
Được thích
7,635
Bài này là kinh điển của phương thức Find.

Function HE_FIND_N(A As Range, B As Range, N As Long) As Variant
' tham số thứ ba là số ký tự cần lấy (7 hoặc 10)
Nhìn Mid(bi.Value, i, 10) = ai.Value và Mid(bi.Value, i, 7) = ai.Value thì thực ra người ta luôn tìm ai.Value bất luận nó có bao nhiêu ký tự. Nếu nhập 10 hoặc 7 mà ai có <>10 và 7 ký tự thì kết quả là RỖNG. Nếu ai có 10 (7) ký tự thì nhập N = 7 (10) sẽ có kết quả là RỖNG.

Vì thế tham số N là thừa. Luôn tìm ai.Value thôi.
 
Upvote 0

VetMini

Chuyên gia GPE
Tham gia
21/12/12
Bài viết
12,176
Được thích
15,616
Nhìn Mid(bi.Value, i, 10) = ai.Value và Mid(bi.Value, i, 7) = ai.Value thì thực ra người ta luôn tìm ai.Value bất luận nó có bao nhiêu ký tự. Nếu nhập 10 hoặc 7 mà ai có <>10 và 7 ký tự thì kết quả là RỖNG. Nếu ai có 10 (7) ký tự thì nhập N = 7 (10) sẽ có kết quả là RỖNG.

Vì thế tham số N là thừa. Luôn tìm ai.Value thôi.
Tôi hiểu lầm người ta muốn minh đinhj lại một trị nào đó nằm trong range A. Cả hai ranges A và B đều có thể gồn nhiều ô, và có thể 2 chiều.

Lúc nhìn lại code bài #4 mới biết mình nhầm.
 
Upvote 0

Ldh1984

Thành viên mới
Tham gia
18/7/21
Bài viết
26
Được thích
3
Bạn thử dùng UDF sau:
PHP:
Function GetID(RngData As Range, txt As String) As String
Dim arrData, v As Variant
arrData = RngData.Value
txt = " " & Replace(txt, "+", " ") & " "
    For Each v In arrData
        If InStr(1, txt, " " & v & " ") > 0 Then
            GetID = v
            Exit For
        End If
    Next v
End Function
Cách sử dụng:

=GetID($B$4:$B$9,D4)

.
Cảm ơn bạn rất nhiều, mình áp dụng thấy code chạy nhanh gấp mấy chục lần code trước đây :)
 
Upvote 0

Ldh1984

Thành viên mới
Tham gia
18/7/21
Bài viết
26
Được thích
3
Bạn thử dùng UDF sau:
PHP:
Function GetID(RngData As Range, txt As String) As String
Dim arrData, v As Variant
arrData = RngData.Value
txt = " " & Replace(txt, "+", " ") & " "
    For Each v In arrData
        If InStr(1, txt, " " & v & " ") > 0 Then
            GetID = v
            Exit For
        End If
    Next v
End Function
Cách sử dụng:

=GetID($B$4:$B$9,D4)

.
Bạn ơi cho mình hỏi thêm tí !
Với code trên thì đại loại đang giới hạn ở chổ:
Mình ví dụ như thế này:
Ở DATA có: TA1564Z --> tìm bằng hàm thì ok ra rất nhanh ^^ tốc độ tuyệt vời.
nhưng nếu dòng tìm kiếm có ký tự là "tA1564z" chẳng hạn vậy thì code trên không tìm ra!
Vậy nhờ bạn chỉ và hỗ trợ thêm ạ ^^ mình chân thành cảm ơn!
 
Upvote 0

Phuocam

Thành viên mới
Tham gia
16/5/13
Bài viết
3,472
Được thích
4,946
Donate (Momo)
Donate
Ở DATA có: TA1564Z --> tìm bằng hàm thì ok ra rất nhanh ^^ tốc độ tuyệt vời.
nhưng nếu dòng tìm kiếm có ký tự là "tA1564z" chẳng hạn vậy thì code trên không tìm ra!

Nếu không phân biệt chữ hoa - chữ thường, bạn thêm tham số "vbTextCompare" sau hàm InStr:

PHP:
Function GetID(RngData As Range, txt As String) As String
Dim arrData, v As Variant
arrData = RngData.Value
txt = " " & Replace(txt, "+", " ") & " "
    For Each v In arrData
        If InStr(1, txt, " " & v & " ", vbTextCompare) > 0 Then
            GetID = v
            Exit For
        End If
    Next v
End Function

.
 
Upvote 0

Ldh1984

Thành viên mới
Tham gia
18/7/21
Bài viết
26
Được thích
3
Nếu không phân biệt chữ hoa - chữ thường, bạn thêm tham số "vbTextCompare" sau hàm InStr:

PHP:
Function GetID(RngData As Range, txt As String) As String
Dim arrData, v As Variant
arrData = RngData.Value
txt = " " & Replace(txt, "+", " ") & " "
    For Each v In arrData
        If InStr(1, txt, " " & v & " ", vbTextCompare) > 0 Then
            GetID = v
            Exit For
        End If
    Next v
End Function

.
thanks bạn nhiều nhiều nha ^^
 
Upvote 0
Top Bottom