Hỗ trợ tạo hàm UDF (Function) tách màu, tách khuôn

[Xuyên đảo băng hồ]

Chào các anh, em có bài này nhờ các anh giúp em tạo hàm UDF (Function) để tách màu tách khuôn với.

Quy tắc như sau:

Quy tắc 1: số + chữ => số là màu, chữ là khuôn

Quy tắc 2: Chữ + số + chữ => Chữ + số là màu, chữ còn lại là khuôn

Quy tắc 3: Chữ + số + chữ + số => Chữ + số là màu. Chữ + số còn lại là khuôn

Em cảm ơn các anh, chị nhiều.

 

[CHAOQUAY]

Chào các anh, em có bài này nhờ các anh giúp em tạo hàm UDF (Function) để tách màu tách khuôn với.

Quy tắc như sau:

Quy tắc 1: số + chữ => số là màu, chữ là khuôn

Quy tắc 2: Chữ + số + chữ => Chữ + số là màu, chữ còn lại là khuôn

Quy tắc 3: Chữ + số + chữ + số => Chữ + số là màu. Chữ + số còn lại là khuôn

Em cảm ơn các anh, chị nhiều.

Thử hàm sau.
Các chuỗi khác 3 mẫu trên ra kết quả thế nào là không đảm bảo gì nhé
Cú pháp:
Lấy màu =Tach(Chuoi, 0)
Lấy khuôn =Tach(Chuoi, 1)

Option Explicit

Function tach(chuoi, n)
Dim j, k
For j = Len(chuoi) To 1 Step -1
    If IsNumeric(Mid(chuoi, j, 1)) = False Then
        k = 1
    Else
        If k = 1 Then
            If n = 0 Then
                tach = Left(chuoi, j)
            Else
                tach = Right(chuoi, Len(chuoi) - j)
            End If
            Exit For
        End If
    End If
Next j
End Function

 

[Xuyên đảo băng hồ]

Em vừa test xong, ngon lành rồi anh CHAOQUAY ơi. Cảm ơn anh nhiều.

 

[Phuocam]

Góp vui:

Function TachMauKhuon(ByVal s As String, Optional ByVal Loai As Boolean = False) As String
Dim i As Long, Vitri As Long
For i = 1 To Len(s) - 1
    If Mid(s, i, 1) Like "#" And Mid(s, i + 1, 1) Like "[!0-9]" Then
        Vitri = i
        Exit For
    End If
Next i
    If Loai = False Then
        TachMauKhuon = VBA.Left(s, Vitri)
    Else
        TachMauKhuon = VBA.Mid(s, Vitri + 1)
    End If
End Function

 

[VetMini]

Góp vui:

For i = 1 To Len(s) - 1
    If Mid(s, i, 1) Like "#" And Mid(s, i + 1, 1) Like "[!0-9]" Then
        Vitri = i
        Exit For
    End If
Next i

Code như thế tuy ngắn nhưng thực tế không hiệu quả vì có một số ký tự phải xét 2 lần. Dung sentinel (flag, cờ) như bài #2 hiệu quả hơn.
Mặt khác, code trên vẫn còn 2 điểm:
1. biến vitri không cần thiết, bởi vì nó là i
2. nếu tìm không được thì vitri là 0

' thuật toán dựa vào lô gic màu kết thúc bằng 1 ký tự số, và tiếp theo đó là ký tự chữ bắt đầu khuôn
' suy ra, một pattern ký tự chữ đi ngay sau một lý tự số là điểm ngăn giữa màu và khuôn
prev = IsNumeric(Left(s, 1)
For pos = 2 To Len(s)
If prev Then
If Not IsNumeric(Mid(s, pos, 1)) Then Exit For
Else
prev = IsNumeric(Mid(s, pos, 1))
End If
Next pos
' nếu pos lớn hơn độ dài chuõi là do tìm không được
If pos <= Len(s) Then TachMauKhuon = Array(Left(s, pos-1), Right(s, Len(s) - pos + 1))

Bài này làm bằng RegEx cũng được. Mẫu pattern là:
\d\D : mẫu nguyên, hoặc
\d(?=\D) : mẫu dòm trước, hoặc
(?=\d)\D : mẫu ngó sau

 

[Phuocam]

Có thể giảm bớt 1 hàm MID:

Function TachMauKhuon(ByVal s As String, Optional ByVal Loai As Boolean = False) As String
Dim i As Long
For i = 1 To Len(s) - 1
    If VBA.Mid(s, i, 2) Like "#[!0-9]" Then
        If Loai = False Then
            TachMauKhuon = VBA.Left(s, i)
        Else
            TachMauKhuon = VBA.Mid(s, i + 1)
        End If
        Exit For
    End If
Next i
    
End Function

 

[VetMini]

RegEx (code chỉ có tính cách minh hoạ cho giải thuật):

With CreateObject("VBScript.RegExp")
.Pattern = "\d\D"
If .Test(s) Then pos = .Execute(s)(0).FirstIndex + 1
End With

 

[batman1]

Cũng tham gia RegEx.

Lấy MẦU thì nhập chiso = 1, lấy KHUÔN thì nhập chiso = 2.

Function TachMauKhuon(ByVal text As String, ByVal chiso As Long) As String
    With CreateObject("VBScript.RegExp")
        .IgnoreCase = True
        .Pattern = "^([a-z]*\d+)([a-z]+\d*)$"
        If .test(text) Then TachMauKhuon = .Replace(text, "$" & chiso)
    End With
End Function

vd.
MẦU =TachMauKhuon($A2;1)
KHUÔN =TachMauKhuon($A2;2)