[VBA] afficher un msgbox différent selon saisie

pepsi

XLDnaute Occasionnel
J'ai un code qui me permet d'identifier les doublons dans une liste.

Un message s'affiche si j'ai des doublons, et passe les cellules en rouge.

meme s'il n'y a pas de doublons dans la liste j'ai quand meme le message MsgBox "Les valeurs suivantes sont en doublon :" & vbLf & L, 64, "Attention...".
sans aucune valeur dans le message.

J'aimerais plutot afficher le message : "aucune valeur en doublons"

comment faire ?

Merci pour votre aide


VB:
  Dim D1, D2, P As Range, C As Range, a(), n As Long, L As String
  [a:d].Interior.ColorIndex = xlNone
  Set D1 = CreateObject("Scripting.Dictionary")
  Set P = Range("A2", [A65000].End(xlUp))
  For Each C In P
   If C.Value <> 0 Then D1.Item(C.Value) = D1.Item(C.Value) + 1
  Next
  Set D2 = CreateObject("Scripting.Dictionary")
  For Each C In P
    If D1.Item(C.Value) > 1 Then
   
          
    C.Interior.ColorIndex = 3
    C.Offset(0, 1).Interior.ColorIndex = 3
    C.Offset(0, 2).Interior.ColorIndex = 3
    C.Offset(0, 3).Interior.ColorIndex = 3
       
      If D2(C.Value) = "" Then D2(C.Value) = C
    End If
  Next
  a = D2.keys
  For n = 0 To UBound(a): L = L & a(n) & vbLf: Next
  MsgBox "Les valeurs suivantes sont en doublon :" & vbLf & L, 64, "Attention..."


End Sub
 

job75

XLDnaute Barbatruc
Bonjour pepsi,
VB:
Sub Doublons()
Dim P As Range, tablo, d1 As Object, i&, x$, d2 As Object, mes$
[A:D].Interior.ColorIndex = xlNone
Set P = Range("A1", [A65000].End(xlUp))
tablo = P.Resize(, 2) 'matrice plus rapide, au moins 2 éléments
Set d1 = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(tablo)
    x = CStr(tablo(i, 1))
    If x <> "" Then d1(x) = d1(x) + 1
Next
Set d2 = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(tablo)
    x = CStr(tablo(i, 1))
    If d1(x) > 1 Then
        P(i).Resize(, 4).Interior.ColorIndex = 3
        If Not d2.exists(x) Then
            d2(x) = ""
            mes = mes & vbLf & x
        End If
    End If
Next
MsgBox IIf(mes = "", "Aucune valeur en doublon", "Les valeurs suivantes sont en doublon :" & mes), 64, "Attention..."
End Sub
A+
 

Paf

XLDnaute Barbatruc
Bonjour,

une solution:
VB:
If D2.count > 0 then

    a = D2.keys

    For n = 0 To UBound(a): L = L & a(n) & vbLf: Next

        MsgBox "Les valeurs suivantes sont en doublon :" & vbLf & L, 64, "Attention..."

Else

        MsgBox "aucune valeur en doublons"

End If
A+

Edit : bonjour job75, et désolé pour la collision.
 
Dernière édition:

Discussions similaires


Haut Bas