Tự động tô màu báo trùng

Liên hệ QC
S

satthuvae

Thành viên thường trực
Tham gia
12/3/09
Bài viết
381
Được thích
52
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!

221552
 

File đính kèm

  • Tự động tô màu báo trùng.xlsx
    426.9 KB · Đọc: 14
satthuvae đã viết:
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
Nhấp chuột vào đây để mở rộng...
Thử code này
Mã: 
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
 
quanghai1969 đã viết:
Thử code này
Mã: 
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
Nhấp chuột vào đây để mở rộng...
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.

221554
Bài đã được tự động gộp:

satthuvae đã viết:
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.

221554
Nhấp chuột vào đây để mở rộng...
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 à.
 
Lần chỉnh sửa cuối:
satthuvae đã viết:
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:


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 à.
Nhấp chuột vào đây để mở rộng...
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.
 
quanghai1969 đã viết:
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.
Nhấp chuột vào đây để mở rộng...
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 đó ạ.
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 ạ.

221584
 

File đính kèm

  • 1563845148107.png
    1563845148107.png
    31.2 KB · Đọc: 3
  • Tự động tô màu báo trùng.xlsm
    310.2 KB · Đọc: 3
satthuvae đã viế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
Nhấp chuột vào đây để mở rộng...
Theo Code của @quanghai1969, chỉnh sửa, thêm theo yêu cầu.
 

File đính kèm

  • MauMe.xlsb
    111.1 KB · Đọc: 15
Ba Tê đã viết:
Theo Code của @quanghai1969, chỉnh sửa, thêm theo yêu cầu.
Nhấp chuột vào đây để mở rộng...
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.

221622
 

File đính kèm

  • MauMe (1).xlsb
    103.2 KB · Đọc: 10
satthuvae đã viế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
Nhấp chuột vào đây để mở rộng...
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.
PHP: 
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
 
Ba Tê đã viết:
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.
PHP: 
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
Nhấp chuột vào đây để mở rộng...
Dạ em cám ơn Thầy nhiều ạ.

Em làm được rùi ạ.
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

H
  • Question
nhờ các bác viết mẫu cho em lệnh dùng checkbox để rút ngắn thời gian thao tác
Trả lời
14
Đọc
285
hiv174
H
Tình nghĩa giang hồ
Hỗ trợ dữ liệu xen kẽ căn bằng theo quy luật.
Trả lời
7
Đọc
74
Phan Thế Hiệp
Phan Thế Hiệp
L
[xin nhờ giúp đỡ] hàm trích xuất ra dữ liệu thỏa mã điều kiện và ghi vào một ô
Trả lời
9
Đọc
284
Lá chanh
L
Emyeuexcel
  • Question
In theo số thứ tự
    • Chấp nhận
Trả lời
3
Đọc
64
Emyeuexcel
Emyeuexcel
C
  • Question
VBA copy 2 vùng dữ liệu từ 1 workbook này sang 2 vùng của workbook khác!
    • Phẫn nộ
Trả lời
9
Đọc
107
Quang_Hải
Quang_Hải
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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

Back
Top Bottom