Giúp đỡ nhập dữ liệu theo điều kiện

[hailong]

Chào cả nhà

Mình muốn nhập dữ liệu theo điều kiện:

VD Nhập Dữ liệu tại ô A2 có font màu đỏ thì ô C2 hiện lên chữ ABC có font màu đỏ.

Nhập Dữ liệu tại ô A4 có font màu xanh thì ô C4 hiện lên chữ DEF có font màu xanh.

Nhập Dữ liệu tại ô A6 có font màu đen thì ô C6 rỗng ""

Cám ơn sự giúp đỡ của các bạn.

HAI LONG - NHA TRANG

 

[SA_DQ]

Bạn dùng macro sau với việc gán cho nó 1 tổ hợp phím tắt

& thực hiện chạy nó bất cứ khi nào bạn muốn tô màu hay gán trị rổng vô cột 'C' của sheets hiện hành

Option Explicit
Sub ToMauCotC()
 Dim lRow As Long, Jw As Long
 Dim Rng As Range, Clls As Range
 
 lRow = Cells(65432, 1).End(xlUp).Row
 
 Set Rng = Range(Cells(1, 1), Cells(lRow, 1))
 For Each Clls In Rng
    
    With Clls
        If .Font.ColorIndex = 3 Then
            .Offset(, 2).Font.ColorIndex = 3
        ElseIf .Font.ColorIndex = 5 Then
            .Offset(, 2).Font.ColorIndex = 5
        ElseIf .Font.ColorIndex < 2 Then
            .Offset(, 2) = ""
        End If
    End With
 Next Clls

End Sub

 

[tigertiger]

Cám ơn SA_DQ

Góp ý 1 chút
Sửa lại cho rút ngắn CT hơn, thì làm như sau

Sub ToMauCotC()
 Dim lRow As Long, Jw As Long
 Dim Rng As Range, Clls As Range
 
 lRow = Cells(65432, 1).End(xlUp).Row
 
 Set Rng = Range(Cells(1, 1), Cells(lRow, 1))
 For Each Clls In Rng
    
    With Clls.Font
        If .ColorIndex = 3 Or .ColorIndex = 5 Then
            Clls.Offset(, 2).Font.ColorIndex = .ColorIndex
        ElseIf .ColorIndex < 2 Then
            Clls.Offset(, 2) = ""
        End If
    End With
 Next Clls

End Sub

Còn nếu Tổng quát lên 1 chút , khi ở ô ở cột A tô màu gì (trừ màu Black và automatic) thì ở Ô tương ứng ở cột C có màu đó lun. Nếu là màu BLACK hay AUTOMATIC thì ô ở cột C bị xóa nội dung

Sub ToMauCotC2()
 Dim lRow As Long, Jw As Long
 Dim Rng As Range, Clls As Range
 
 lRow = Cells(65432, 1).End(xlUp).Row
 
 Set Rng = Range(Cells(1, 1), Cells(lRow, 1))
 For Each Clls In Rng
    
    With Clls.Font
        If .ColorIndex < 2 Then
            Clls.Offset(, 2) = ""
        Else
            Clls.Offset(, 2).Font.ColorIndex = .ColorIndex
        End If
    End With
 Next Clls

End Sub