Tô màu 1 vài ký tự trong cell theo điều kiện

[anhtuan1066]

Ai cũng biết chức năng Conditional Formating dùng đễ Format cell theo 1 d/k nào đó.. Vậy bạn nào có giãi pháp gì đó có thể tô màu 1 vài ký tự trong cell theo 1 điều kiện cho trước ko?
Tức là ko phải tô màu toàn bộ ký tự trong cell mà chỉ tô những ký tự thỏa mãn điều kiện thôi... Ví dụ trong cell có từ ANH TUAN thì tô màu đỏ và chỉ tô nội trong từ ANH TUAN này thôi...
Tôi nghĩ chắc chỉ có dùng VBA mới giãi quyết dc yêu cầu này nhưng ko biết nó là code gì? Nhờ các bạn giúp cho!
ANH TUẤN

 

[chibi]

Đây là một cách (Còn hạn chế chưa tô hết các kí tự thỏa mãn xuất hiện nhiều lần).

Private Sub Worksheet_Change(ByVal Target As Range)
Target.Font.ColorIndex = 0
vi_tri = InStr(Target.Value, "vidu")
If vi_tri <> 0 Then
    With Target.Characters(Start:=vi_tri, Length:=4).Font
        .ColorIndex = 3
    End With
End If
End Sub

 

[SA_DQ]

Chú thử đoạn mã này xem sao!

Option Explicit

Sub ToMau()
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "12/45 Ng Trãi Q3"
    With ActiveCell.Characters(Start:=7, Length:=7).Font
        .ColorIndex = 5
    End With
    
    Range("C4").Select
    ActiveCell.FormulaR1C1 = "124/5 Ng Trãi Q5"
    With ActiveCell.Characters(Start:=1, Length:=5).Font
        .ColorIndex = 3
    End With
    Range("b2").Select
End Sub

 

[anhtuan1066]

Bác SA ơi, code bác hay lắm... Ý em muốn là thế này đây:
1> Đầu tiên em có 1 bảng dử liệu khoảng 100 dòng từ A3 đến F100
2> Tại cell A1 em gõ vào những ký tự em cần tìm.. ví dụ em gõ vào chử TUAN
3> Khi đó code sẽ dò tìm trong bảng, thấy em nào có chử TUAN thì tô màu...
Bác giúp em với!
ANH TUẤN

 

[Mr Okebab]

Bác SA ơi, code bác hay lắm... Ý em muốn là thế này đây:
1> Đầu tiên em có 1 bảng dử liệu khoảng 100 dòng từ A3 đến F100
2> Tại cell A1 em gõ vào những ký tự em cần tìm.. ví dụ em gõ vào chử TUAN
3> Khi đó code sẽ dò tìm trong bảng, thấy em nào có chử TUAN thì tô màu...
Bác giúp em với!
ANH TUẤN

Bác xem nhé :

Sub ToMau(Mang As Range, KyTu As String, Mau As Byte)
    Application.ScreenUpdating = False
    On Error Resume Next
    Dim Ma As Range
    Dim i As Integer, m As Integer, i1 As Integer
    i1 = Len(KyTu)
    For Each Ma In Mang
        For i = 1 To Len(Ma) - i1 + 1
            If Mid$(Ma, i, i1) = KyTu Then
                Ma.Characters(Start:=i, Length:=i1).Font.ColorIndex = Mau
            End If
        Next
        i = 0
     Next
    Application.ScreenUpdating = True
End Sub

Thân!

 

[Paraduong]

Cái này mình làm theo kiểu "nông dân", nhưng hình như nó cũng giải quyết được vấn đề!

 

[SA_DQ]

Bác SA ơi, Ý em muốn là thế này đây:
1> Đầu tiên em có 1 bảng dữ liệu khoảng 100 dòng từ A3 đến F100
2> Tại cell A1 em gõ vào những ký tự em cần tìm.. ví dụ em gõ vào chử TUAN
3> Khi đó code sẽ dò tìm trong bảng, thấy em nào có chử TUAN thì tô màu...
Bác giúp em với!
ANH TUẤN

Thay vì A1 hãy gõ vô H2

Option Explicit

Sub SearchAndReplace()
    Dim Rng As Range, Rng0 As Range
    Dim ChuoiTim, DDai As Byte, BDau As Integer
    
    ChuoiTim = UCase$(Range("H2")):             DDai = Len(ChuoiTim)
    If ChuoiTim = "" Then ChuoiTim = "Tu?n":    Range("H2") = ""
    Range("B3").Select:     Selection.CurrentRegion.Select
    Set Rng = Selection
    For Each Rng0 In Rng
        BDau = InStr(UCase$(Rng0), ChuoiTim)
        If BDau > 0 Then
            Rng0.Select
            ActiveCell.FormulaR1C1 = Rng0.Value
            With ActiveCell.Characters(Start:=BDau, Length:=DDai).Font
                .ColorIndex = DDai
            End With
        End If
    Next Rng0
End Sub

 

[Mr Okebab]

Vì Sub trên chỉ đổi được 1 lần trong một chuỗi (Nếu chuỗi cần đổi màu có mặt nhiều lần trong 1 cell thì nó mới chỉ đổi được 1 lần)
Vì ậy mình đã sửa lại Sub này.
các bạn tham khảo :

Sub ToMau(Mang As Range, KyTu As String, Mau As Byte)
    Application.ScreenUpdating = False
    On Error Resume Next
    Dim Ma As Range
    Dim i As Integer, m As Integer, i1 As Integer
    i1 = Len(KyTu)
    For Each Ma In Mang
        For i = 1 To Len(Ma) - i1 + 1
            If Mid$(Ma, i, i1) = KyTu Then
                Ma.Characters(Start:=i, Length:=i1).Font.ColorIndex = Mau
            End If
        Next
        i = 0
     Next
    Application.ScreenUpdating = True
End Sub

Thân!

 

[anhtuan1066]

Oh... ho... Đông vui quá... Trong mấy file tôi chỉ dùng dc của Bắp và của bạn Paraduong... Cảm ơn 2 bạn
Thật sự là vì tôi ko hiểu về VBA lắm (có thể nói là ngu).. nên mấy code của chibi hay của bác SA tôi ko biết phải dùng thế nào nữa...
Bác SA và chibi ơi, có thể góp vui bằng 1 file cụ thể dc ko? Em dốt món này lắm nên "bó càng" với code luôn! Hic... Hic...

 

[SA_DQ]

Theo iêu cầu của Tuấn!

nên mấy code của chibi hay của bác SA tôi ko biết phải dùng thế nào nữa...
Bác SA và chibi ơi, có thể góp vui bằng 1 file cụ thể dc ko? Em dốt món này lắm nên "bó càng" với code luôn! Hic... Hic...

Gỏi bằng chứng lên đây!

 

[Mr Okebab]

Gỏi bằng chứng lên đây!

Cũng hay đấy bác ạ.
Tuy nhiên nếu trong Cell có 2 chuỗi cần đổi màu trở lên (2 chữ Tuấn chẳng hạn), thì nó chỉ đổi 1 chữ Tuấn

Bác cải tiến nhé.

Thân!

 

[SA_DQ]

Thì cải tiến được rồi ây BAB ơi, ời!

nếu trong Cell có 2 chuỗi cần đổi màu trở lên (2 chữ Tuấn chẳng hạn), thì nó chỉ đổi 1 chữ Tuấn Bác cải tiến nhé.
Thân!

Option Explicit:  Option Base 1
Sub SearchAndReplace()
    Dim Rng As Range:     ManiColor Range("Q8"), "Nguyên"
    Range("Q7").Select
End Sub

Sub ManiColor(Rng As Range, StrC As String)
    Dim iJ As Integer, Dem As Integer
    
    Rng = UCase$(Rng):      StrC = UCase$(StrC)
    Rng.Select
    ActiveCell.FormulaR1C1 = Rng.Value
    Dim Mang(9), ViTri As Integer
    ViTri = 1
    Do
        iJ = InStr(ViTri, Rng, StrC)
        If iJ < 1 Then
            Exit Do
        Else
            ViTri = iJ + 1:   Dem = 1 + Dem
            Mang(Dem) = iJ
        End If
    Loop
    Mang(Dem + 1) = Len(Rng)
    
    On Error Resume Next
    If Dem = 0 Then Exit Sub
    With ActiveCell.Characters(Start:=1, Length:=Mang(1) - 1).Font
        .ColorIndex = xlAutomatic
    End With
    
    Dim DDai As Integer, lBD As Integer, LTruoc As Integer, lSau As Integer
    
    DDai = Len(StrC)
    For iJ = 1 To Dem
        lBD = Mang(iJ)
        With ActiveCell.Characters(Start:=lBD, Length:=DDai).Font
            .ColorIndex = DDai
        End With
        
        LTruoc = lBD + DDai + 1
        lSau = Mang(iJ + 1) - Mang(iJ) - DDai
        
        With ActiveCell.Characters(Start:=LTruoc, Length:=lSau).Font
            .ColorIndex = xlAutomatic
        End With
        
    Next iJ
    
End Sub

 

[bachthanh2007]

có anh chị em biết cách tạo một công thức cho bảng tính với tính
ví dụ: trong bảng tính có nhiều dòng nhưng chỉ sử dụng một hàm (vlookup) bình thường copy kéo xuống là được nhưng có cách nào chỉ cần dùng một là cho cả bảng tính gồm nhiều dòng, anh chị nào có thể giúp vào với em cám ơn nhiều huhuhu

 

[anhtuan1066]

Bạn muốn thế thì có 2 cách:
1> Dùng công thức mãng
2> Đặt name...
Nói riêng trường hợp công thức mãng nhé. Ví dụ tại B5 bạn có công thức sau:

=VLOOKUP(A5,DULIEU,2,0)

và công thức này sẽ kéo xuống đến B20... vậy thì bạn quét chọn 1 lần từ B5 đến B20, click chuột vào thanh công thức và gõ:

=VLOOKUP(A5:A20,DULIEU,2,0)
Bấm Ctrl + Shift + Enter đễ kết thúc

Cách đặt name thì cũng gần tương tự
Ngòai ra vẫn còn vài cách khác, chẳng hạn khi bạn hoàn tất xong công thức VLOOKUP(A5,DULIEU,2,0) bạn rà chuột vào góc dưới bên phải cell, ngay chổ kéo fill ấy, double click vào nó thì nó sẽ copy và paste toàn bộ từ B5 xuống đến hết bảng tính