Cần giúp đỡ tô màu cho các ô trùng nhau (Phải có 1 ô trong các ô trùng có màu sẵn có) (1 người xem)

[hung2412]

Chào Quý vị và các bạn GPE!
Nhờ Quý vị và các bạn giúp đỡ cho tôi vấn đề này với, cụ thể như sau:
Tự động tô màu vàng cho các ô có ký tự trùng nhau dọc theo cột B, với điều kiện trong các ô có ký tự trùng nhau đó phải có 1 ô có màu vàng sẵn có.
Ví dụ:
- Tô màu vàng cho các ô B5, B8, B13, B16 vì: 4 ô này có ký tự trùng nhau là "CT02/19" và có ô B8 có màu vàng sẵn có.
- Không tô màu vàng cho các ô B6, B9, B10 vì: Không có 1 ô nào trong 3 ô đó có màu vàng sẵn có (Mặc dù cả 3 ô đó có ký tự trùng nhau là "OPN02/01-NN").
Mong Quý vị và các bạn GPE chỉ giáo!
Trân trọng cảm ơn!
P/s: Có file đính kèm. Tôi xài Excel 2003.

 

[nghiaphuc]

Chào Quý vị và các bạn GPE!
Nhờ Quý vị và các bạn giúp đỡ cho tôi vấn đề này với, cụ thể như sau:
Tự động tô màu vàng cho các ô có ký tự trùng nhau dọc theo cột B, với điều kiện trong các ô có ký tự trùng nhau đó phải có 1 ô có màu vàng sẵn có.
Ví dụ:
- Tô màu vàng cho các ô B5, B8, B13, B17 vì: 4 ô này có ký tự trùng nhau là "CT02/19" và có ô B8 có màu vàng sẵn có.
- Không tô màu vàng cho các ô B6, B9, B10 vì: Không có 1 ô nào trong 3 ô đó có màu vàng sẵn có (Mặc dù cả 3 ô đó có ký tự trùng nhau là "OPN02/01-NN").
Mong Quý vị và các bạn GPE chỉ giáo!
Trân trọng cảm ơn!
P/s: Có file đính kèm.

Tôi nghĩ là bài này không thể sử dụng Conditional Formating được mà cần dùng đến VBA. Hơn nữa, ở để thuận tiện thì nên dùng Excel 2007+, vì ở các phiên bản này có chức năng lọc theo màu.
Xin gửi bạn một code tham khảo (code này chỉ chạy được ở Excel 2007+):
[GPECODE=vb]Sub Test()
Dim Rng As Range, Cll As Range, Cll1 As Range
Application.ScreenUpdating = False
Sheet1.Activate
With [B4].CurrentRegion
.AutoFilter Field:=1, Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
Set Rng = .SpecialCells(12)
End With
For Each Cll In Rng
With [B4].CurrentRegion
.AutoFilter Field:=1, Criteria1:=Cll
.SpecialCells(12).Interior.ColorIndex = 6
End With
Next
[B4].CurrentRegion.AutoFilter
[B4].Interior.Pattern = xlNone
Application.ScreenUpdating = True
End Sub[/GPECODE]

 

[hung2412]

Tôi nghĩ là bài này không thể sử dụng Conditional Formating được mà cần dùng đến VBA. Hơn nữa, ở để thuận tiện thì nên dùng Excel 2007+, vì ở các phiên bản này có chức năng lọc theo màu.
Xin gửi bạn một code tham khảo (code này chỉ chạy được ở Excel 2007+):
[GPECODE=vb]Sub Test()
Dim Rng As Range, Cll As Range, Cll1 As Range
Application.ScreenUpdating = False
Sheet1.Activate
With [B4].CurrentRegion
.AutoFilter Field:=1, Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
Set Rng = .SpecialCells(12)
End With
For Each Cll In Rng
With [B4].CurrentRegion
.AutoFilter Field:=1, Criteria1:=Cll
.SpecialCells(12).Interior.ColorIndex = 6
End With
Next
[B4].CurrentRegion.AutoFilter
[B4].Interior.Pattern = xlNone
Application.ScreenUpdating = True
End Sub[/GPECODE]

Cảm ơn Quý vị đã nhiệt tình giúp đỡ, đáng tiếc là tôi đang xài Excel 2003.

 

[nghiaphuc]

Cảm ơn Quý vị đã nhiệt tình giúp đỡ, đáng tiếc là tôi đang xài Excel 2003.

Excel 2003 thì bạn thử code này xem:
[GPECODE=vb]Sub ToMau()
Dim Rng As Range, Cll As Range
Application.ScreenUpdating = False
Sheet1.Activate
Set Rng = [B4].CurrentRegion
For Each Cll In Rng
If Cll.Interior.ColorIndex = 6 Then
With Rng
.AutoFilter Field:=1, Criteria1:=Cll
.SpecialCells(12).Interior.ColorIndex = 6
End With
End If
Next
[B4].CurrentRegion.AutoFilter
[B4].Interior.Pattern = xlNone
Application.ScreenUpdating = True
End Sub[/GPECODE]
Code này nhìn có vẻ ngắn gọn hơn code trên, tuy nhiên so sánh về tốc độ (khi dữ liệu lớn) thì không nhanh bằng code trên do lệnh bị lặp lại. Chẳng hạn với giá trị CT02/04, khi biến Cll chạy đến ô B32, vì ô này được tô màu vàng nên các ô có cùng giá trị với nó (B32:B33, B36:B37) được tô màu vàng. Khi chạy đến các ô B33, B36, B37, cũng vì mỗi ô này đã được tô nền nên lệnh tô màu các ô có cùng giá trị lại bị lặp lại thêm 3 lần nữa một cách vô ích. Kết quả là code sẽ chạy chậm hơn nếu dữ liệu lớn.

Ngoài lề một chút: Trong code ở bài trên, tôi khai báo dư 1 biến Cll1, do ý tưởng ban đầu và khi viết code không trùng nhau.

 

[hung2412]

Cần giúp đỡ tô màu cho các ô trùng nhau (Không tô màu đè lên ô trùng có màu sẵn có)

Chào Quý vị và các bạn GPE!
Nhờ Quý vị và các bạn giúp đỡ cho tôi vấn đề này với, cụ thể như sau:
Tự động tô màu vàng cho các ô có ký tự trùng nhau dọc theo cột B (Không tô màu đè lên ô trùng có màu sẵn có). Nếu có 2 ô có ký tự trùng nhau dọc theo cột B (1 ô chưa có màu và 1 ô có màu sẵn có) thì vẫn tô màu vàng cho ô chưa có màu.
Ví dụ:
- Tô màu vàng cho các ô B26, B30 vì: 2 ô này có ký tự trùng nhau là "CT02/10".
- Tô màu vàng cho các ô B5, B13, B16 vì: 3 ô này có ký tự trùng nhau là "CT02/19" (Không tô màu vàng cho ô B8 vì ô này có màu tím sẵn có, mặc dù ô này cũng trùng ký tự là "CT02/19").
- Tô màu vàng cho ô B14 vì: Ô B14 này có trùng ký tự với ô B12 (Ô này có màu tím sẵn có) là "CT02/01", ô B12 có màu tím sẵn có nên giữ nguyên.
Mong Quý vị và các bạn GPE chỉ giáo!
Trân trọng cảm ơn!
P/s: Có file đính kèm. Tôi xài Excel 2003.

 

[hung2412]

Excel 2003 thì bạn thử code này xem:
[GPECODE=vb]Sub ToMau()
Dim Rng As Range, Cll As Range
Application.ScreenUpdating = False
Sheet1.Activate
Set Rng = [B4].CurrentRegion
For Each Cll In Rng
If Cll.Interior.ColorIndex = 6 Then
With Rng
.AutoFilter Field:=1, Criteria1:=Cll
.SpecialCells(12).Interior.ColorIndex = 6
End With
End If
Next
[B4].CurrentRegion.AutoFilter
[B4].Interior.Pattern = xlNone
Application.ScreenUpdating = True
End Sub[/GPECODE]
Code này nhìn có vẻ ngắn gọn hơn code trên, tuy nhiên so sánh về tốc độ (khi dữ liệu lớn) thì không nhanh bằng code trên do lệnh bị lặp lại. Chẳng hạn với giá trị CT02/04, khi biến Cll chạy đến ô B32, vì ô này được tô màu vàng nên các ô có cùng giá trị với nó (B32:B33, B36:B37) được tô màu vàng. Khi chạy đến các ô B33, B36, B37, cũng vì mỗi ô này đã được tô nền nên lệnh tô màu các ô có cùng giá trị lại bị lặp lại thêm 3 lần nữa một cách vô ích. Kết quả là code sẽ chạy chậm hơn nếu dữ liệu lớn.

Ngoài lề một chút: Trong code ở bài trên, tôi khai báo dư 1 biến Cll1, do ý tưởng ban đầu và khi viết code không trùng nhau.

Vâng, xin cảm ơn Quý vị đêm hôm nhiệt tình giúp đỡ, tôi thấy khá ổn, có còn hơn không.

 

[Ba Tê]

Cảm ơn Quý vị đã nhiệt tình giúp đỡ, đáng tiếc là tôi đang xài Excel 2003.

Tui luôn khoái "Dic_to"Thử chạy code này xem sao:

Public Sub GPE()
Dim Rng As Range, Cll As Range
Set Rng = Range([B5], [B65536].End(xlUp))
With CreateObject("Scripting.Dictionary")
    For Each Cll In Rng
        If Cll.Interior.ColorIndex <> xlNone Then
            If Not .Exists(Cll.Value) Then .Add Cll.Value, Empty
        End If
    Next
    For Each Cll In Rng
        If .Exists(Cll.Value) Then Cll.Interior.ColorIndex = 6
    Next Cll
End With
Set Rng = Nothing
End Sub