Tô màu những cells trùng được Filter

queluatb · 8/4/22

Em nhờ các Thầy/Cô, Anh/chị hỗ trợ code giúp em vấn đề về Filter và đánh dấu các Cells trùng nhau
+ Nếu không thể đánh dấu các màu thì có thể đánh dấu một màu duy nhất.
Em có mô tả trong file đính kèm
Em xin cám ơn

SA_DQ · 8/4/22

Bạn có thể sẽ phải nghĩ đến chuyện xài AdvancedFilter & chỉ sau đó thì muốn tô màu hay sắp xếp lại gì gì đó . . . theo ý

queluatb · 8/4/22

SA_DQ đã viết:
Bạn có thể sẽ phải nghĩ đến chuyện xài AdvancedFilter & chỉ sau đó thì muốn tô màu hay sắp xếp lại gì gì đó . . . theo ý

Em xin cám ơn, mong thầy gợi ý thêm
+ Sau khi Filter được rồi, dùng câu lệnh như nào để có thể lựa chọn được vùng lọc

batman1 · 9/4/22

Code để tô mầu cũng có thể viết được. Cái khó là phải biết chọn thời điểm để chạy code.
Khi chọn ô trên sheet thì có sự kiện SelectionChange sảy ra nên nếu viết code trong Sub Worksheet_SelectionChange thì code đó sẽ được thực thi ngay lập tức khi người dùng chọn ô. Tương tự với sự kiện Change khi người dùng chỉnh sửa ô trên sheet.

Nhưng nếu tôi không nhầm thì không có sự kiện nào sảy ra khi người dùng thực hiện Filter. Vậy làm thế nào để chạy code? Tôi không biết vì thế tôi nghĩ là nên thực hiện như sau:

Gán cho macro một phím tắt. Khi người dùng muốn thì nhấn phím tắt để chạy code. Tức sau khi lọc thì nhấn phím tắt để chạy code. Không lọc mà thích chạy code thì cũng nhấn phím. Thế thôi.

Khi dữ liệu không được lọc, tức tất cả dữ liệu đều đang hiển thị, thì code không làm gì cả ngoài việc xóa các mầu đã tô. Khi dữ liệu ở trạng thái lọc thì các ô trong cột cần xét sẽ được tô mầu. Các ô liên tiếp cùng giá trị thì có cùng mầu. Như vậy chỉ cần 2 mầu thay đổi xen kẽ. Và nên sắp xếp dữ liệu nguồn theo cột cần xét.

BuiQuangThuan · 9/4/22

queluatb đã viết:
Em xin cám ơn, mong thầy gợi ý thêm
+ Sau khi Filter được rồi, dùng câu lệnh như nào để có thể lựa chọn được vùng lọc

2 cái này có giống nhau đâu mà tô màu vào nhỉ

queluatb · 9/4/22

batman1 đã viết:
Code để tô mầu cũng có thể viết được. Cái khó là phải biết chọn thời điểm để chạy code.
Khi chọn ô trên sheet thì có sự kiện SelectionChange sảy ra nên nếu viết code trong Sub Worksheet_SelectionChange thì code đó sẽ được thực thi ngay lập tức khi người dùng chọn ô. Tương tự với sự kiện Change khi người dùng chỉnh sửa ô trên sheet.

Nhưng nếu tôi không nhầm thì không có sự kiện nào sảy ra khi người dùng thực hiện Filter. Vậy làm thế nào để chạy code? Tôi không biết vì thế tôi nghĩ là nên thực hiện như sau:

Gán cho macro một phím tắt. Khi người dùng muốn thì nhấn phím tắt để chạy code. Tức sau khi lọc thì nhấn phím tắt để chạy code. Không lọc mà thích chạy code thì cũng nhấn phím. Thế thôi.

Khi dữ liệu không được lọc, tức tất cả dữ liệu đều đang hiển thị, thì code không làm gì cả ngoài việc xóa các mầu đã tô. Khi dữ liệu ở trạng thái lọc thì các ô trong cột cần xét sẽ được tô mầu. Các ô liên tiếp cùng giá trị thì có cùng mầu. Như vậy chỉ cần 2 mầu thay đổi xen kẽ. Và nên sắp xếp dữ liệu nguồn theo cột cần xét.

Nhờ thấy giúp code em với

queluatb · 9/4/22

BuiQuangThuan đã viết:
View attachment 274223
2 cái này có giống nhau đâu mà tô màu vào nhỉ

mình gửi lại file ở bài #1

BuiQuangThuan · 9/4/22

queluatb đã viết:
mình gửi lại file ở bài #1

vậy là bạn muốn bôi màu ở côt B à? có nghìn mã thì nhiều màu lắm nhỉ

queluatb · 9/4/22

BuiQuangThuan đã viết:
vậy là bạn muốn bôi màu ở côt B à? có nghìn mã thì nhiều màu lắm nhỉ

có 1000 mã trên cột B, nhưng khi filter chỉ có 3-4 mã là nhiều

batman1 · 9/4/22

queluatb đã viết:
Nhờ thấy giúp code em với

Tôi làm đúng như gợi ý ở bài #4. Nếu bạn nghĩ lại và muốn làm khác thì thôi khỏi phải tải tập tin đính kèm.
Code chỉ tô 2 mầu xen kẽ. Sub to_mau có 2 phiên bản. Phiên bản hiện đang là chú thích tuy code dài hơn nhưng theo tôi chạy nhanh hơn.

Code truy cập từng ô trên sheet nên chắc chắn chậm. Tôi để ý thấy là thường khi tôi khai hỏa thì tự dưng rất nhiều người sẽ lao vào. Bạn cứ kiên nhẫn đợi. Tôi chỉ chơi qua thế thôi.

Trong code có hằng số cotKT = 2. Đó là chỉ số cột cần xét giá trị để tô mầu - cột thứ mấy của vùng lọc. Vd. vùng lọc là K4:O35 mà cột cần xét là M thì cotKT = 3 - cột thứ 3 của vùng lọc. Nếu cần xét cột khác thì chỉnh sửa cotKT.

Phím tắt là Ctrl + t

queluatb · 10/4/22

batman1 đã viết:
Tôi làm đúng như gợi ý ở bài #4. Nếu bạn nghĩ lại và muốn làm khác thì thôi khỏi phải tải tập tin đính kèm.
Code chỉ tô 2 mầu xen kẽ. Sub to_mau có 2 phiên bản. Phiên bản hiện đang là chú thích tuy code dài hơn nhưng theo tôi chạy nhanh hơn.

Code truy cập từng ô trên sheet nên chắc chắn chậm. Tôi để ý thấy là thường khi tôi khai hỏa thì tự dưng rất nhiều người sẽ lao vào. Bạn cứ kiên nhẫn đợi. Tôi chỉ chơi qua thế thôi.

Trong code có hằng số cotKT = 2. Đó là chỉ số cột cần xét giá trị để tô mầu - cột thứ mấy của vùng lọc. Vd. vùng lọc là K4:O35 mà cột cần xét là M thì cotKT = 3 - cột thứ 3 của vùng lọc. Nếu cần xét cột khác thì chỉnh sửa cotKT.

Phím tắt là Ctrl + t

Vâng, em cám ơn Thầy

bebo021999 · 13/4/22

Nếu nhiều mã thì thứ tự màu sẽ như trong hình.
Vì không trigger được sự kiện chọn filter, nên khi filter xong, chịu khó click thêm lần nữa vào ô E1:

PHP:

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("E1")) Is Nothing Then Exit Sub
Dim lr&, k&, cell As Range, rng As Range, dic As Object
Set dic = CreateObject("Scripting.dictionary")
lr = Cells(Rows.Count, "B").End(xlUp).Row
Set rng = Range("B2:B" & lr).SpecialCells(xlCellTypeVisible)
If rng.Rows.Count = lr - 1 Then
    Range("A2:E" & lr).Interior.Color = xlNone
Else
    k = 3
    For Each cell In rng
        If Not dic.exists(cell.value) Then
            k = k + 1
            dic.Add cell.value, k
            cell.Interior.ColorIndex = k
        Else
            cell.Interior.ColorIndex = dic(cell.value)
        End If
    Next
    dic.RemoveAll
End If
End Sub

queluatb · 14/4/22

bebo021999 đã viết:

Nếu nhiều mã thì thứ tự màu sẽ như trong hình.
Vì không trigger được sự kiện chọn filter, nên khi filter xong, chịu khó click thêm lần nữa vào ô E1:

PHP:

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("E1")) Is Nothing Then Exit Sub
Dim lr&, k&, cell As Range, rng As Range, dic As Object
Set dic = CreateObject("Scripting.dictionary")
lr = Cells(Rows.Count, "B").End(xlUp).Row
Set rng = Range("B2:B" & lr).SpecialCells(xlCellTypeVisible)
If rng.Rows.Count = lr - 1 Then
    Range("A2:E" & lr).Interior.Color = xlNone
Else
    k = 3
    For Each cell In rng
        If Not dic.exists(cell.value) Then
            k = k + 1
            dic.Add cell.value, k
            cell.Interior.ColorIndex = k
        Else
            cell.Interior.ColorIndex = dic(cell.value)
        End If
    Next
    dic.RemoveAll
End If
End Sub

vâng em cám ơn nhiều

Tô màu những cells trùng được Filter

queluatb

Thành viên thường trực

File đính kèm

SA_DQ

/(hông là gì!

queluatb

Thành viên thường trực

batman1

Thành viên gạo cội

BuiQuangThuan

❆❆❆❆❆❆❆❆❆❆❆❆

queluatb

Thành viên thường trực

queluatb

Thành viên thường trực

BuiQuangThuan

❆❆❆❆❆❆❆❆❆❆❆❆

queluatb

Thành viên thường trực

batman1

Thành viên gạo cội

File đính kèm

queluatb

Thành viên thường trực

bebo021999

Thành viên gạo cội

File đính kèm

queluatb

Thành viên thường trực

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng