Xin code giúp MsgBox chỉ hiện 1 lần mà không phải chạy 2 lần vòng lặp

[LYSM]

Em chào các anh chị!
Em có 1 code tô màu các cell có ký tự trùng nhau (giống như Duplicate value trong Conditional Formating nhưng có them MsgBox). Code như bên dưới, em muốn hỏi có cách nào mà MsgBox chỉ hiện 1 lần mà không phải chạy lại 2 lần vòng lặp như code dưới không ạ? Em cám ơn!

Public Sub Trung_ma()
Dim Cll As Range
With Sheet1
Set Rng = .Range(.[A4], .[A65000].End(xlUp))
 For Each Cll In Rng
    Cll.Interior.Color = RGB(255, 255, 255)
    If Application.WorksheetFunction.CountIf(Rng, Cll) > 1 Then
        Cll.Interior.Color = RGB(255, 199, 206)
    End If
 Next Cll
 
 For Each Cll In Rng
 If Cll.Interior.Color = RGB(255, 199, 206) Then
   MsgBox "Trung ma so, xin kiem tra lai"
    Exit Sub
   End If
 Next Cll
 
End With
End Sub

 

[snow25]

Em chào các anh chị!
Em có 1 code tô màu các cell có ký tự trùng nhau (giống như Duplicate value trong Conditional Formating nhưng có them MsgBox). Code như bên dưới, em muốn hỏi có cách nào mà MsgBox chỉ hiện 1 lần mà không phải chạy lại 2 lần vòng lặp như code dưới không ạ? Em cám ơn!

Public Sub Trung_ma()
Dim Cll As Range
With Sheet1
Set Rng = .Range(.[A4], .[A65000].End(xlUp))
For Each Cll In Rng
    Cll.Interior.Color = RGB(255, 255, 255)
    If Application.WorksheetFunction.CountIf(Rng, Cll) > 1 Then
        Cll.Interior.Color = RGB(255, 199, 206)
    End If
Next Cll

For Each Cll In Rng
If Cll.Interior.Color = RGB(255, 199, 206) Then
   MsgBox "Trung ma so, xin kiem tra lai"
    Exit Sub
   End If
Next Cll

End With
End Sub

Đây bạn xem.

Public Sub Trung_ma()
Dim Cll As Range, dk As Long
With Sheet1
Set Rng = .Range(.[A4], .[A65000].End(xlUp))
For Each Cll In Rng
    Cll.Interior.Color = RGB(255, 255, 255)
    If Application.WorksheetFunction.CountIf(Rng, Cll) > 1 Then
        Cll.Interior.Color = RGB(255, 199, 206)
        dk = 1
    End If
Next Cll


If dk = 1 Then
   MsgBox "Trung ma so, xin kiem tra lai"
End If
End With
End Sub

 

[be_09]

Em chào các anh chị!
Em có 1 code tô màu các cell có ký tự trùng nhau (giống như Duplicate value trong Conditional Formating nhưng có them MsgBox). Code như bên dưới, em muốn hỏi có cách nào mà MsgBox chỉ hiện 1 lần mà không phải chạy lại 2 lần vòng lặp như code dưới không ạ? Em cám ơn!

Public Sub Trung_ma()
Dim Cll As Range
With Sheet1
Set Rng = .Range(.[A4], .[A65000].End(xlUp))
For Each Cll In Rng
    Cll.Interior.Color = RGB(255, 255, 255)
    If Application.WorksheetFunction.CountIf(Rng, Cll) > 1 Then
        Cll.Interior.Color = RGB(255, 199, 206)
    End If
Next Cll

For Each Cll In Rng
If Cll.Interior.Color = RGB(255, 199, 206) Then
   MsgBox "Trung ma so, xin kiem tra lai"
    Exit Sub
   End If
Next Cll

End With
End Sub

Thử code sau sẽ tô màu trùng lặp cùng lúc nhiều cột.

Sub ToMau_TrungLap()
Dim ChonCell As Range
Dim VungChon As Range

Set VungChon = Sheet1.Range("A3").CurrentRegion
    'Xóa màu khi thay doi trùng Loop
    VungChon.Interior.ColorIndex = 0
'Loop qua vùng Data
For Each ChonCell In VungChon
    'Kiem tra trùng
    If WorksheetFunction.CountIf(VungChon, ChonCell.Value) > 1 Then
        'Tô màu xanh cho các giá tri trùng
        ChonCell.Interior.ColorIndex = 8
    End If
Next
MsgBox "MÀU XANH LÀ TRÙNG LAP, XIN KIÊM TRA LAI"
End Sub

 

[VetMini]

Đây bạn xem.

Public Sub Trung_ma()
Dim Cll As Range, dk As Long
With Sheet1
Set Rng = .Range(.[A4], .[A65000].End(xlUp))
For Each Cll In Rng
    Cll.Interior.Color = RGB(255, 255, 255)
    If Application.WorksheetFunction.CountIf(Rng, Cll) > 1 Then
        Cll.Interior.Color = RGB(255, 199, 206)
        dk = 1
    End If
Next Cll


If dk = 1 Then
   MsgBox "Trung ma so, xin kiem tra lai"
End If
End With
End Sub

1. Nếu range là vùng liên tục thì chỉ cần tô màu 1 lần và xét 1 lần thôi.
2. Nếu màu cố định thì chỉ tính 1 lần thôi. Vòng lặp bắt nó tính bấy nhiêu lần à?

colorDef = RGB(255, 255, 255)
colorHil = RGB(255, 199, 206)
Rng.Interior.Color = colorDef
For Each Cll In Rng
If Application.WorksheetFunction.CountIf(Rng, Cll) > 1 Then
Cll.Interior.Color = colorHi
End If
Next Cll
If Rng.Interior.Color <> colorDef Then
' có thay đổi --> msgbox