Tham chiếu ô màu có điều kiện

[Jenhcv]

Bảng nhập máy là điện thoại ạ, mình quản lý theo imie. Màu bên sheet nhập máy mỗi ô là màu đại diện cho từng imie.

Mình cần là khi sheet bán hàng nhập số imie, thì ô màu tương ứng với số imie đó sẽ hiện bên sheet bán hàng.

Mình có gửi kèm file ví dụ theo ạ, cám ơn các bác.

 

[be_09]

Mình muốn ô màu bên sheet NHAPMAY hiện bên ô màu của Sheet BANHANG theo số imie nhập bên sheet BANHANG.

Mình có gửi kèm file ví dụ theo ạ, cám ơn các bác.

Góp ý cho bạn:
Bạn chưa nêu rõ là tô màu thì dựa vào cột nào? Sheet NHAPMAY bạn tô màu loạn xạ nên chẳng hiểu gì cả.
Trong excel nói về màu sắc thì nó có quy luật mã màu của nó chứ không phải tùy ý muốn tô màu nào cũng được.
Còn muốn tô màu không theo quy luật thì dùng Conditional Formatting, nhưng nó có nhược điểm là sử dụng vài ngàn dòng thì File sẽ ì ạch và làm tăng dung lượng File.

 

[Jenhcv]

Góp ý cho bạn:
Bạn chưa nêu rõ là tô màu thì dựa vào cột nào? Sheet NHAPMAY bạn tô màu loạn xạ nên chẳng hiểu gì cả.
Trong excel nói về màu sắc thì nó có quy luật mã màu của nó chứ không phải tùy ý muốn tô màu nào cũng được.
Còn muốn tô màu không theo quy luật thì dùng Conditional Formatting, nhưng nó có nhược điểm là sử dụng vài ngàn dòng thì File sẽ ì ạch và làm tăng dung lượng File.

Vâng do mình không trình bày rõ nên bác hơi khó hiểu.

Bảng nhập máy là điện thoại ạ, mình quản lý theo imie. Màu bên sheet nhập máy mỗi ô là màu đại diện cho từng imie.

Mình cần là khi sheet bán hàng nhập số imie, thì ô màu tương ứng với số imie đó sẽ hiện bên sheet bán hàng.

 

[excel_lv1.5]

Bảng nhập máy là điện thoại ạ, mình quản lý theo imie. Màu bên sheet nhập máy mỗi ô là màu đại diện cho từng imie.

Mình cần là khi sheet bán hàng nhập số imie, thì ô màu tương ứng với số imie đó sẽ hiện bên sheet bán hàng.
Mình có gửi kèm file ví dụ theo ạ, cám ơn các bác.

Bạn dùng code này ở sheet BANHANG:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A2:A10000]) Then
    Dim i As Long, ncolor As Long, arr, rng As Range, cell As Range
    Set rng = Sheets("NHAPMAY").Range("A3:A" & Sheets("NHAPMAY").[A10000].End(xlUp).Row)
    Set cell = rng.Find(Target, LookIn:=xlValues, lookat:=xlWhole)
    If Not cell Is Nothing Then
        Target.Offset(, 3).Interior.ColorIndex = cell.Offset(, 4).Interior.ColorIndex
    End If
End If
End Sub

 

[Jenhcv]

Bạn dùng code này ở sheet BANHANG:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A2:A10000]) Then
    Dim i As Long, ncolor As Long, arr, rng As Range, cell As Range
    Set rng = Sheets("NHAPMAY").Range("A3:A" & Sheets("NHAPMAY").[A10000].End(xlUp).Row)
    Set cell = rng.Find(Target, LookIn:=xlValues, lookat:=xlWhole)
    If Not cell Is Nothing Then
        Target.Offset(, 3).Interior.ColorIndex = cell.Offset(, 4).Interior.ColorIndex
    End If
End If
End Sub

Cám ơn bạn rất nhìu.

 

[Jenhcv]

Lại phiền bác, mình áp dụng macro vào thì chạy trơn chu chỉ khi nhập liệu vào thì báo lỗi run time (99) mình bấm END thì nó lại chạy tiếp, Nhưng vậy bất tiện quá bác sửa lại đc ko ạ.

 

[excel_lv1.5]

Lại phiền bác, mình áp dụng macro vào thì chạy trơn chu chỉ khi nhập liệu vào thì báo lỗi run time (99) mình bấm END thì nó lại chạy tiếp, Nhưng vậy bất tiện quá bác sửa lại đc ko ạ.View attachment 189731

Bạn chỉnh lại code như vầy:

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [A2:A10000]) Then
    Dim i As Long, ncolor As Long, arr, rng As Range, cell As Range
    Set rng = Sheets("NHAPMAY").Range("A3:A" & Sheets("NHAPMAY").[A10000].End(xlUp).Row)
    Set cell = rng.Find(Target, LookIn:=xlValues, lookat:=xlWhole)
    If Not cell Is Nothing Then
        Target.Offset(, 3).Interior.ColorIndex = cell.Offset(, 4).Interior.ColorIndex
    End If
End If
End Sub

 

[Jenhcv]

Bạn chỉnh lại code như vầy:

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [A2:A10000]) Then
    Dim i As Long, ncolor As Long, arr, rng As Range, cell As Range
    Set rng = Sheets("NHAPMAY").Range("A3:A" & Sheets("NHAPMAY").[A10000].End(xlUp).Row)
    Set cell = rng.Find(Target, LookIn:=xlValues, lookat:=xlWhole)
    If Not cell Is Nothing Then
        Target.Offset(, 3).Interior.ColorIndex = cell.Offset(, 4).Interior.ColorIndex
    End If
End If
End Sub

cám ơn bác trơn tru rồi ạ

 

[luuhonghai]

Bạn chỉnh lại code như vầy:

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [A2:A10000]) Then
    Dim i As Long, ncolor As Long, arr, rng As Range, cell As Range
    Set rng = Sheets("NHAPMAY").Range("A3:A" & Sheets("NHAPMAY").[A10000].End(xlUp).Row)
    Set cell = rng.Find(Target, LookIn:=xlValues, lookat:=xlWhole)
    If Not cell Is Nothing Then
        Target.Offset(, 3).Interior.ColorIndex = cell.Offset(, 4).Interior.ColorIndex
    End If
End If
End Sub

Anh ơi có thể giúp em với bài toán tương tự được không ạ. Em cần tô 1 vùng (vd: từ cột B -> cột L) điều kiện điền ở cột A, tham chiếu màu theo bảng ạ. Em cảm ơn anh!

 

[cantl]

Anh ơi có thể giúp em với bài toán tương tự được không ạ. Em cần tô 1 vùng (vd: từ cột B -> cột L) điều kiện điền ở cột A, tham chiếu màu theo bảng ạ. Em cảm ơn anh!

Người về từ hố bom.