Tự động tô màu báo trùng (1 người xem)

[satthuvae]

Em chào Anh/Chị

Em có File excel, em đang làm thủ công báo màu dựa vào Conditional Formatting.

Cột A, cột B đó là dữ liệu đầu vào, em tạo cột H là kết hợp dữ liệu của cột A và cột B và e sẽ tìm các dòng ở cột H giống nhau e tô màu vàng như theo file đính kèm.

Do dữ liệu của em đầu vào nhiều dòng, và em đang làm thủ công, khi e lọc cột H để tìm màu vàng excle chạy khá chậm.

Nhờ Anh/Chị các bạn xem giúp e có ứng dụng Vba tự động, sẽ lọc và tô màu vàng như hình ảnh trên được không ạ.

Em xin cám ơn!

 

[Quang_Hải]

Em chào Anh/Chị

Em có File excel, em đang làm thủ công báo màu dựa vào Conditional Formatting.

Cột A, cột B đó là dữ liệu đầu vào, em tạo cột H là kết hợp dữ liệu của cột A và cột B và e sẽ tìm các dòng ở cột H giống nhau e tô màu vàng như theo file đính kèm.

Do dữ liệu của em đầu vào nhiều dòng, và em đang làm thủ công, khi e lọc cột H để tìm màu vàng excle chạy khá chậm.

Nhờ Anh/Chị các bạn xem giúp e có ứng dụng Vba tự động, sẽ lọc và tô màu vàng như hình ảnh trên được không ạ.

Em xin cám ơn!

View attachment 221552

Thử code này

Sub To_Mau_Trung_Du_Lieu()
Dim sArr(), i As Long, tmp As String, Dic As Object, sh As Worksheet
Set sh = Sheets("Du lieu")
sArr = sh.Range("A2", sh.[A65536].End(3)).Resize(, 2).Value
sh.Range("A2", sh.[A65536].End(3)).Resize(, 2).Interior.ColorIndex = xlNone
Set Dic = CreateObject("scripting.dictionary")
For i = 1 To UBound(sArr)
   tmp = sArr(i, 1) & sArr(i, 2)
   If Not Dic.exists(tmp) Then
      Dic.Add tmp, i
   Else
      sh.Cells(i + 1, 1).Resize(, 2).Interior.ColorIndex = 6
      sh.Cells(Dic.Item(tmp) + 1, 1).Resize(, 2).Interior.ColorIndex = 6
   End If
Next
End Sub

 

[satthuvae]

Thử code này

Sub To_Mau_Trung_Du_Lieu()
Dim sArr(), i As Long, tmp As String, Dic As Object, sh As Worksheet
Set sh = Sheets("Du lieu")
sArr = sh.Range("A2", sh.[A65536].End(3)).Resize(, 2).Value
sh.Range("A2", sh.[A65536].End(3)).Resize(, 2).Interior.ColorIndex = xlNone
Set Dic = CreateObject("scripting.dictionary")
For i = 1 To UBound(sArr)
   tmp = sArr(i, 1) & sArr(i, 2)
   If Not Dic.exists(tmp) Then
      Dic.Add tmp, i
   Else
      sh.Cells(i + 1, 1).Resize(, 2).Interior.ColorIndex = 6
      sh.Cells(Dic.Item(tmp) + 1, 1).Resize(, 2).Interior.ColorIndex = 6
   End If
Next
End Sub

Em cám ơn Anh quanghai1969

Nhờ Anh xem giúp em có thể chỉnh tô màu báo dòng từ cột A đến cột F được không, giống như File Ảnh ở dưới ạ.

Hiện tại excel chỉ báo màu vàng cột A và cột B thôi ạ.

Em cám ơn Anh.

Bài đã được tự động gộp: 22/7/19

Em cám ơn Anh quanghai1969

Nhờ Anh xem giúp em có thể chỉnh tô màu báo dòng từ cột A đến cột F được không, giống như File Ảnh ở dưới ạ.

Hiện tại excel chỉ báo màu vàng cột A và cột B thôi ạ.

Em cám ơn Anh.

Nhờ Anh Quanghai1969,

Anh có thể giúp em khi tạo nút VBA đó, ngoài tô mầu ra có thể lọc luôn ra được không ạ, nghĩa là lọc các dòng tô màu vàng giống nhau đó ạ. Và nếu ấn tiếp nút đó thì hiện ra ban đầu nhưng vẫn báo tô màu vàng để dễ kiểm tra.

Cám ơn Anh rất nhiều à.

 

[Quang_Hải]

Em cám ơn Anh quanghai1969

Nhờ Anh xem giúp em có thể chỉnh tô màu báo dòng từ cột A đến cột F được không, giống như File Ảnh ở dưới ạ.

Hiện tại excel chỉ báo màu vàng cột A và cột B thôi ạ.

Em cám ơn Anh.

View attachment 221554

Bài đã được tự động gộp: 22/7/19

Nhờ Anh Quanghai1969,

Anh có thể giúp em khi tạo nút VBA đó, ngoài tô mầu ra có thể lọc luôn ra được không ạ, nghĩa là lọc các dòng tô màu vàng giống nhau đó ạ. Và nếu ấn tiếp nút đó thì hiện ra ban đầu nhưng vẫn báo tô màu vàng để dễ kiểm tra.

Cám ơn Anh rất nhiều à.

1. Bạn tìm chỗ nào có từ Resize, thay số 2 thành số 6 thì sẽ tô màu đến cột F. Đúng ra bạn nên thử vọc code, dần dần sẽ hiểu. Mình từng học theo cách đó.
2. Về vấn đề lọc ra cũng đơn giản nhưng hiện tại mình không online nên chưa viết code được. Chờ xem có thành viên nào xem qua sẽ giúp cho bạn nha.

 

[satthuvae]

1. Bạn tìm chỗ nào có từ Resize, thay số 2 thành số 6 thì sẽ tô màu đến cột F. Đúng ra bạn nên thử vọc code, dần dần sẽ hiểu. Mình từng học theo cách đó.
2. Về vấn đề lọc ra cũng đơn giản nhưng hiện tại mình không online nên chưa viết code được. Chờ xem có thành viên nào xem qua sẽ giúp cho bạn nha.

Em cám ơn Anh quanghai1969, e đã khắc phục được rùi ạ.

Em nhờ Anh và các Anh/Chị xem giúp em, có thể vẫn nút vba đó, mình lọc được tô màu luôn và nếu ấn lại thì trả về dòng bình thường (những vẫn báo mầu vàng) nghĩa là bỏ lọc đó ạ.


Và ngoài ra khi e thấy khi e xóa dữ liệu này, từ dòng 8, từ tên "Cao Thị Nhung" đi, sau đó ấn lại nút báo trùng thì dữ liệu vẫn còn lưu lại tô mầu trước mà không trả về ô trắng. Nhờ Anh/Chị xem giúp em, khi mình nhập dữ liệu mới vào, ấn nút "Báo trùng" đó thì sẽ chạy theo mới, ko lưu lại dòng tô mầu mà không có dữ liệu.
Em xin gửi File đính kèm nhờ Anh/Chị xem giúp em.
Em xin cám ơn ạ.

 

[Ba Tê]

Em cám ơn Anh quanghai1969, e đã khắc phục được rùi ạ.

Em nhờ Anh và các Anh/Chị xem giúp em, có thể vẫn nút vba đó, mình lọc được tô màu luôn và nếu ấn lại thì trả về dòng bình thường (những vẫn báo mầu vàng) nghĩa là bỏ lọc đó ạ.
View attachment 221582

Và ngoài ra khi e thấy khi e xóa dữ liệu này, từ dòng 8, từ tên "Cao Thị Nhung" đi, sau đó ấn lại nút báo trùng thì dữ liệu vẫn còn lưu lại tô mầu trước mà không trả về ô trắng. Nhờ Anh/Chị xem giúp em, khi mình nhập dữ liệu mới vào, ấn nút "Báo trùng" đó thì sẽ chạy theo mới, ko lưu lại dòng tô mầu mà không có dữ liệu.
Em xin gửi File đính kèm nhờ Anh/Chị xem giúp em.
Em xin cám ơn ạ.

View attachment 221584

Theo Code của @quanghai1969, chỉnh sửa, thêm theo yêu cầu.

 

[satthuvae]

Theo Code của @quanghai1969, chỉnh sửa, thêm theo yêu cầu.

Dạ e cám ơn Thầy ạ.

Dạ quả thực không giám làm phiền Thầy nhiều ạ.

Dạ chạy ngon quá.

 

[satthuvae]

Theo Code của @quanghai1969, chỉnh sửa, thêm theo yêu cầu.

Dạ Thầy ơi,

Em có một chút vấn để nho nhỏ, em ngồi mò mãi mà không tự sửa được ạ.

Trong vba của Thầy khi ấn nút "Loc Trung" thì sẽ xóa hết toàn bộ màu mà đã định dạng màu từ trước ạ.

Do em muốn người nhập cột A đến cột F chỉ là màu trắng, còn các cột khác và dòng thứ tự 1 e để màu xám cho dễ nhìn và kiểm tra. Còn lọc, tô vàng chỉ diễn ra ở cột A đến cột F thôi à. (Dòng 1 cũng theo định dạng xám) và các cột khác không bị mất đi khi ấn nút "lọc trùng" ạ.

Giống như hình ảnh này ạ. Em gửi Thầy File đính kèm.

Em xin cám ơn Thầy.

 

[Ba Tê]

Dạ Thầy ơi,

Em có một chút vấn để nho nhỏ, em ngồi mò mãi mà không tự sửa được ạ.

Trong vba của Thầy khi ấn nút "Loc Trung" thì sẽ xóa hết toàn bộ màu mà đã định dạng màu từ trước ạ.

Do em muốn người nhập cột A đến cột F chỉ là màu trắng, còn các cột khác và dòng thứ tự 1 e để màu xám cho dễ nhìn và kiểm tra. Còn lọc, tô vàng chỉ diễn ra ở cột A đến cột F thôi à. (Dòng 1 cũng theo định dạng xám) và các cột khác không bị mất đi khi ấn nút "lọc trùng" ạ.

Giống như hình ảnh này ạ. Em gửi Thầy File đính kèm.

Em xin cám ơn Thầy.

View attachment 221622

Bạn có biết tô màu 1.000.000 dòng nhân với 16.000 cột sẽ ảnh hưởng thế nào với file của bạn không? Nếu cần phân biệt "lề phải" thì chỉ cần tô màu cột H từ dòng 1 đến 1000 (dữ liệu mà bạn dự trù có tối đa) thôi.
Bạn thay Sub sGpe() cũ trong Module bằng cái này.

Sub sGpe()
Dim Dic As Object, sArr(), I As Long, R As Long, Tmp As String
Set Dic = CreateObject("Scripting.Dictionary")
Dic.CompareMode = vbTextCompare
With Sheets("Dulieu")
    .Range("A2:F10000").Interior.ColorIndex = 0
    sArr = .Range("A2", .[A65536].End(xlUp)).Resize(, 2).Value
    R = UBound(sArr)
    For I = 1 To R
        Tmp = sArr(I, 1) & sArr(I, 2)
        Dic.Item(Tmp) = Dic.Item(Tmp) + 1
    Next I
    For I = 1 To R
        Tmp = sArr(I, 1) & sArr(I, 2)
        If Dic.Item(Tmp) > 1 Then .Range("A" & I + 1).Resize(, 6).Interior.ColorIndex = 6
    Next I
End With
Set Dic = Nothing
End Sub

 

[satthuvae]

Bạn có biết tô màu 1.000.000 dòng nhân với 16.000 cột sẽ ảnh hưởng thế nào với file của bạn không? Nếu cần phân biệt "lề phải" thì chỉ cần tô màu cột H từ dòng 1 đến 1000 (dữ liệu mà bạn dự trù có tối đa) thôi.
Bạn thay Sub sGpe() cũ trong Module bằng cái này.

Sub sGpe()
Dim Dic As Object, sArr(), I As Long, R As Long, Tmp As String
Set Dic = CreateObject("Scripting.Dictionary")
Dic.CompareMode = vbTextCompare
With Sheets("Dulieu")
    .Range("A2:F10000").Interior.ColorIndex = 0
    sArr = .Range("A2", .[A65536].End(xlUp)).Resize(, 2).Value
    R = UBound(sArr)
    For I = 1 To R
        Tmp = sArr(I, 1) & sArr(I, 2)
        Dic.Item(Tmp) = Dic.Item(Tmp) + 1
    Next I
    For I = 1 To R
        Tmp = sArr(I, 1) & sArr(I, 2)
        If Dic.Item(Tmp) > 1 Then .Range("A" & I + 1).Resize(, 6).Interior.ColorIndex = 6
    Next I
End With
Set Dic = Nothing
End Sub

Dạ em cám ơn Thầy nhiều ạ.

Em làm được rùi ạ.