Tìm và tô màu ô trùng (1 người xem)

[toandiennuoc123]

Chào các bạn, (chúc các bạn 1 Trung thu vui vẻ) nhờ các bạn giải quyết hộ tôi bài này với. Xin cám ơn

 

[Quang_Hải]

Chào các bạn, (chúc các bạn 1 Trung thu vui vẻ) nhờ các bạn giải quyết hộ tôi bài này với. Xin cám ơn

Code của bạn đây

Private Sub CommandButton1_Click()
Dim cell
For Each cell In [B2:M32]
  If cell = [P2] Then
    cell.Interior.ColorIndex = 3
    [n65536].End(3).Offset(1) = Cells(cell.Row, 1) & "-" & Cells(1, cell.Column)
  End If
Next
End Sub

Private Sub CommandButton2_Click()
[B2:M32].Interior.ColorIndex = xlNone
[N2:N100].ClearContents
End Sub

 

[toandiennuoc123]

Code của bạn đây

Private Sub CommandButton1_Click()
Dim cell
For Each cell In [B2:M32]
  If cell = [P2] Then
    cell.Interior.ColorIndex = 3
    [n65536].End(3).Offset(1) = Cells(cell.Row, 1) & "-" & Cells(1, cell.Column)
  End If
Next
End Sub

Private Sub CommandButton2_Click()
[B2:M32].Interior.ColorIndex = xlNone
[N2:N100].ClearContents
End Sub

cám ơn quanghai đã giúp đỡ, trong phần y/c của tôi có mục xuất hiện ngày tháng, khi tôi thử thì được đúng 1 lần đầu tiên, đóng và mở lại cũng không được nữa, tôi gửi lại file này nhờ bạn xem hộ, xin cám ơn

 

[Quang_Hải]

cám ơn quanghai đã giúp đỡ, trong phần y/c của tôi có mục xuất hiện ngày tháng, khi tôi thử thì được đúng 1 lần đầu tiên, đóng và mở lại cũng không được nữa, tôi gửi lại file này nhờ bạn xem hộ, xin cám ơn

Bạn sửa lại dòng này

[N2:N10000].ClearContents

 

[toandiennuoc123]

Bạn sửa lại dòng này

[N2:N10000].ClearContents

OK,rất tuyệt. Chúc bạn cuối tuần vui vẻ.

 

[changngoc]

Chào anh Hải,

Anh giúp em tìm dữ liệu trùng chỉ thuộc hai vùng ( arrange ) A6:A30 và E18:E35. Vùng khác có dữ liệu nhưng không cần xét trùng.

Anh xem tham khảo file đính kèm giúp em.
Cam on anh.

 

[Quang_Hải]

Chào anh Hải,

Anh giúp em tìm dữ liệu trùng chỉ thuộc hai vùng ( arrange ) A6:A30 và E18:E35. Vùng khác có dữ liệu nhưng không cần xét trùng.

Anh xem tham khảo file đính kèm giúp em.
Cam on anh.

Tô màu vàng hết nhé

Sub tomau()
Dim dl1, dl2, i, j
Set dl1 = [A6:A30]
Set dl2 = [E18:E35]
dl1.Interior.ColorIndex = xlNone
dl2.Interior.ColorIndex = xlNone
For i = 1 To dl1.Rows.Count
   For j = 1 To dl2.Rows.Count
      If dl1(i, 1) <> "" And dl1(i, 1) = dl2(j, 1) Then
         dl1(i, 1).Interior.ColorIndex = 6
         dl2(j, 1).Interior.ColorIndex = 6
      End If
   Next
Next
End Sub

Hoặc xanh đỏ tím vàng lộn xộn

Sub tomau()
Dim dl1, dl2, i, j, n
Set dl1 = [A6:A30]
Set dl2 = [E18:E35]
dl1.Interior.ColorIndex = xlNone
dl2.Interior.ColorIndex = xlNone
n = 2
For i = 1 To dl1.Rows.Count
   For j = 1 To dl2.Rows.Count
      If dl1(i, 1) <> "" And dl1(i, 1) = dl2(j, 1) Then
         n = n + 1
         dl1(i, 1).Interior.ColorIndex = n
         dl2(j, 1).Interior.ColorIndex = n
      End If
   Next
   If n = 56 Then n = 2
Next
End Sub

 

[changngoc]

Hi anh,

giữa các dữ liệu trùng có màu khác nhau. Ví dụ: AA trùng ở cột A hoặc cột E thì màu vàng, AB trùng ở cột A hoặc cột E thì có màu xanh.

thanks.

 

[Quang_Hải]

Hi anh,

giữa các dữ liệu trùng có màu khác nhau. Ví dụ: AA trùng ở cột A hoặc cột E thì màu vàng, AB trùng ở cột A hoặc cột E thì có màu xanh.

thanks.

Không hiểu bạn muốn tô màu kiểu nào, đọc hoài vẫn không hiểu

 

[changngoc]

Trong file em gửi ở bài trước có phân biệt 2 màu khác nhau đó anh ( vì chỉ có 2 dữ liệu trùng). Nếu 3 dữ liệu trùng thì tô 3 màu khác nhau.

 

[changngoc]

[/PHP]
Hoặc xanh đỏ tím vàng lộn xộn

Sub tomau()
Dim dl1, dl2, i, j, n
Set dl1 = [A6:A30]
Set dl2 = [E18:E35]
dl1.Interior.ColorIndex = xlNone
dl2.Interior.ColorIndex = xlNone
n = 2
For i = 1 To dl1.Rows.Count
   For j = 1 To dl2.Rows.Count
      If dl1(i, 1)  "" And dl1(i, 1) = dl2(j, 1) Then
         n = n   1
         dl1(i, 1).Interior.ColorIndex = n
         dl2(j, 1).Interior.ColorIndex = n
      End If
   Next
   If n = 56 Then n = 2
Next
End Sub

[/QUOTE]

Đoạn này đúng yêu cầu em cần. Em Cảm ơn.

 

[Quang_Hải]

Trong file em gửi ở bài trước có phân biệt 2 màu khác nhau đó anh ( vì chỉ có 2 dữ liệu trùng). Nếu 3 dữ liệu trùng thì tô 3 màu khác nhau.

Code hơi dài ra tí mới xử được vụ này, hy vọng là trúng

Sub tomau()
Dim dl1 As Range, dl2 As Range, d As Object, key(), item(), tim As Object
Dim i As Long, j As Long, k As Long, n As Long, ii As Long
Set d = CreateObject("scripting.dictionary")
Set dl1 = [A6:A30]
Set dl2 = [E18:E35]
dl1.Interior.ColorIndex = xlNone
dl2.Interior.ColorIndex = xlNone
n = 2
For i = 1 To dl2.Rows.Count
   n = n + 1
   If dl2(i, 1) <> "" And Not d.exists(dl2(i, 1)) Then d.Add dl2(i, 1), n
Next
key = d.keys: item = d.items
For i = 0 To UBound(key)
   ii = IIf(item(i) > 56, item(i) - 53, item(i))
   For j = 1 To dl1.Rows.Count
      If dl1(j, 1) = key(i) Then
         dl1(j, 1).Interior.ColorIndex = ii
      End If
   Next
   For k = 1 To dl2.Rows.Count
      Set tim = dl1.Find(key(i), , , xlWhole)
      If Not tim Is Nothing Then
         If dl2(k, 1) = key(i) Then
            dl2(k, 1).Interior.ColorIndex = ii
         End If
      End If
   Next
Next
End Sub

 

[changngoc]

Trong đoạn code: If dl1(i, 1) "" And dl1(i, 1) = dl2(j, 1) Then
nếu em thêm 01 điều kiện nữa là ko tô màu các ô có giá trị trùng là "ABC" thì em thêm vào như thế nào ạ ?

If dl1(i, 1) And("","ABC") And dl1(i, 1) = dl2(j, 1) Then... ==> bị lỗi.

 

[Quang_Hải]

Trong đoạn code: If dl1(i, 1) <> "" And dl1(i, 1) = dl2(j, 1) Then
nếu em thêm 01 điều kiện nữa là ko tô màu các ô có giá trị trùng là "ABC" thì em thêm vào như thế nào ạ ?

If dl1(i, 1) <> "" And dl1(i,1) = "ABC" And dl1(i, 1) = dl2(j, 1) Then... ==> hết lỗi nhưng không biết có đúng kết quả hay không