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

[Ldh1984]

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

 

[Hoàng Tuấn 868]

Sao rải bài nhiều nơi vậy bạn, nên đọc Nội quy diễn đàn đã nhé.

 

[Ldh1984]

Sao rải bài nhiều nơi vậy bạn, nên đọc Nội quy diễn đàn đã nhé.

hi, mình mới vào
Cho mình xin lỗi!

 

[Phuocam]

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:

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)

.

 

[VetMini]

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

 

[batman1]

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.

 

[VetMini]

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.

 

[Ldh1984]

Bạn thử dùng UDF sau:

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

 

[Ldh1984]

Bạn thử dùng UDF sau:

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!

 

[Phuocam]

Ở 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:

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

.

 

[Ldh1984]

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

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 ^^