Hỏi về tô màu chữ của các chữ cuối của họ,chữ cuối của tên đệm và nguyên tên? (1 người xem)

[KUMI]

Xin chào mọi nguời!
Em muốn hỏi có thể tô màu chữ như hình đính kèm này được không ạ?
Tô màu chữ ở cột dữ liệu đó ạ:

Mong được giúp đỡ, Xin cám ơn!

 

[SA_DQ]

Bạn kích 1 ô cần tô màu & chạy thử macro sau

Option Explicit
Sub gpeToMau()
 Dim StrC As String, VTr As Byte, jJ As Byte
 Const KT = " "
 
 StrC = Selection.Value
 Do
    VTr = InStr(VTr + 1, StrC, KT)
    If VTr < 1 Then Exit Do
    TMau VTr - 1
 Loop
 End Sub

[SIZE=2][B]Sub TMau(TM As Byte)[/B]
    With ActiveCell.Characters(Start:=TM, Length:=1).Font
        .ColorIndex = 3
    End With
[B]End Sub[/B][/SIZE]

 

[KUMI]

Option Explicit
Sub gpeToMau()
 Dim StrC As String, VTr As Byte, jJ As Byte
 Const KT = " "
 
 StrC = Selection.Value
 Do
    VTr = InStr(VTr + 1, StrC, KT)
    If VTr < 1 Then Exit Do
    TMau VTr - 1
 Loop
 End Sub

[SIZE=2][B]Sub TMau(TM As Byte)[/B]
    With ActiveCell.Characters(Start:=TM, Length:=1).Font
        .ColorIndex = 3
    End With
[B]End Sub[/B][/SIZE]

Em cảm ơn Thầy đã giúp đỡ!
Nhưng mà như vậy mới chỉ được đạt 80% yêu cầu của đề Thầy ạ!
Vì còn chữ KUMI nữa nguyên cả Tên em không thấy tô màu.

Thêm nữa Thầy có thể chuyển cho em code trên thành Hàm tự tạo được khộng ạ?
Hàm tự tạo tại ô C7. Nghĩa là nhập dữ liệu vào ô C7 enter thì code sẽ tự tô màu mà không cần phải kích hoạt code cho mỗi lần nhập nữa ạ!
Em xin cảm ơn!

 

[ndu96081631]

Thêm nữa Thầy có thể chuyển cho em code trên thành Hàm tự tạo được khộng ạ?
Hàm tự tạo tại ô C7. Nghĩa là nhập dữ liệu vào ô C7 enter thì code sẽ tự tô màu mà không cần phải kích hoạt code cho mỗi lần nhập nữa ạ!
Em xin cảm ơn!

Mấy cái vụ format (tô màu, kẻ khung...) không thể làm thành hàm tự tạo được. Đơn giản vì đã gọi là hàm thì nó chỉ có chức năng TÍNH TOÁN chứ không thể LÀM ĐEP
Điều bạn nói tôi đoán là bạn muốn 1 sự kiện Change ---> Tức gõ dữ liệu thì code chạy
Chắc vậy! Tự mình nghiên cứ WorksheetChange xem

 

[ChanhTQ@]

Nghiên cứu xong thì đối chiếu với macro sau

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim StrC As String, VTr As Byte, jJ As Byte, Cuoi As Byte
 Const KT = " "
 
 If Not Intersect(Target, Columns("c:C")) Is Nothing Then
    StrC = Selection.Value
    Do
        Cuoi = VTr
        VTr = InStr(VTr + 1, StrC, KT)
        If VTr >= 1 Then
            TMau VTr - 1
        Else
            Exit Do
        End If
    Loop
    TMau Cuoi, 9
 End If
End Sub

​

[B]Sub TMau(TM As Byte, Optional Mot As Byte = 1)
[/B]    With ActiveCell.Characters(Start:=TM, Length:=Mot).Font
        .ColorIndex = IIf(Mot = 1, 3, 4)
    End With
[B]End Sub
[/B]