Thử công thức này:Nhờ mọi người giúp mình viết hàm để xác định màu sắc đầu tiên xuất hiện trong chuỗi SẢN PHẨM ạ.
Bỏ lâu rồi, chừ thử viết 1 đoạn code ngắn ngắn mà vất vả quá. Mọi người đừng cười.Chào mọi người.
Nhờ mọi người giúp mình viết hàm để xác định màu sắc đầu tiên xuất hiện trong chuỗi SẢN PHẨM ạ. Mình xin gửi kèm file.
Cám ơn mọi người rất nhiều.
View attachment 273449
Function SearchColor(ByVal strC As String)
Dim aColor, i&, iFrt%
aColor = Range("A2:A11")
For i = 1 To UBound(aColor)
If InStr(1, strC, aColor(i, 1)) > 0 Then
If iFrt > 0 Then
If iFrt > InStr(1, strC, aColor(i, 1)) Then
iFrt = InStr(1, strC, aColor(i, 1))
End If
Else
iFrt = InStr(1, strC, aColor(i, 1))
End If
End If
Next
SearchColor = Mid(strC, iFrt, InStr(iFrt, strC, " ") - iFrt)
End Function
Function FindColor(ByVal rng As Range, ByVal strC As String) As String
Dim arrColor, i&, lMax&, lFind
arrColor = rng.Value
lMax = Len(strC) + 1
For i = 1 To UBound(arrColor, 1)
lFind = InStr(1, strC, arrColor(i, 1))
If lFind > 0 And lFind < lMax Then
FindColor = arrColor(i, 1)
lMax = lFind
End If
Next
End Function
Option Explicit
Function MauSac(ByVal clRng As Range, Str As String) As String
Static Re As Object
If Re Is Nothing Then Set Re = CreateObject("VBScript.Regexp")
With Re
.Global = True
.ignorecase = True
.Pattern = "(" & Join(Application.Transpose(clRng.Value), "|") & ")(?=\W|$)"
If .test(Str) Then MauSac = .Execute(Str)(0)
End With
End Function
Bữa nay mới thấy được cái Pattern siêu thế đó.Góp vui thêm code khác:
Mã:Option Explicit Function MauSac(ByVal clRng As Range, Str As String) As String Static Re As Object If Re Is Nothing Then Set Re = CreateObject("VBScript.Regexp") With Re .Global = True .ignorecase = True .Pattern = "(" & Join(Application.Transpose(clRng.Value), "|") & ")(?=\W|$)" If .test(Str) Then MauSac = .Execute(Str)(0) End With End Function
Viết lỗi rồi nha bạn: MauSac("abczNâu")Góp vui thêm code khác:
Mã:Option Explicit Function MauSac(ByVal clRng As Range, Str As String) As String Static Re As Object If Re Is Nothing Then Set Re = CreateObject("VBScript.Regexp") With Re .Global = True .ignorecase = True .Pattern = "(" & Join(Application.Transpose(clRng.Value), "|") & ")(?=\W|$)" If .test(Str) Then MauSac = .Execute(Str)(0) End With End Function
Function ColorFirst(Text As String) As String
Static Re As Object
If Re Is Nothing Then
Set Re = VBA.CreateObject("VBScript.Regexp")
Re.Global = False
Re.ignorecase = True
Re.Pattern = "\b(" & ChrW(272) & ChrW(7887) & "|Cam|V" & ChrW(224) & "ng|L" & ChrW(7909) & "c|Lam|Ch" & ChrW(224) & "m|T" & ChrW(237) & "m|Tr" & ChrW(7855) & "ng|" & ChrW(272) & "en|N" & ChrW(226) & "u" & ")\b"
End If
If Re.test(Text) Then
ColorFirst = Re.Execute(Text)(0)
End If
End Function
Màu có thể gồm 1 từ (đỏ, cam, vàng,..) hoặc 2 từ (đỏ đô, đỏ đậm, vàng chanh, xanh ngọc,...). Nếu 2 từ thì có dấu SPACE ở giữa
Vậy bài #6 chuẩn chỉ, chuẩn cơm bố mẹ nấu luôn. Không hề tội lỗi tí tẹo nào cả.Màu có thể gồm 1 từ (đỏ, cam, vàng,..) hoặc 2 từ (đỏ đô, đỏ đậm, vàng chanh, xanh ngọc,...). Nếu 2 từ thì có dấu SPACE ở giữa
Trường hợp màu có nhiều từ, bạn sắp xếp theo độ dài của màu từ lớn đến nhỏ, vì nếu trùng công thức sẽ trả về kết quả đầu tiên.Màu có thể gồm 1 từ (đỏ, cam, vàng,..) hoặc 2 từ (đỏ đô, đỏ đậm, vàng chanh, xanh ngọc,...). Nếu 2 từ thì có dấu SPACE ở giữa
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2