Trouver adresse de cellules

Bonjour,

La formule suivante trouve le nombre de différences que j'ai entre deux listes

tmp1 = Application.CountIf([W:AF], 1).

J'aimerais obtenir les adresses des cellules fautives.

Et inclure ces adresses dans un Msgbox.

Je peux trouver avec un Find l'adresse de la première occurence mais le findnext n'a pas l'air de fonctionner ou je n'ai pas la bonne syntaxe.

Merci beaucoup de votre aide

Claire

Bonsoir,

proposition de modification de ton code

Sub essai()

    Dim nbErr As Long
    Set r = Range("W2:" & Range("AF" & Rows.Count).End(xlUp).Address)
    nbErr = Application.CountIf(r, 1)
    pa = ""
    If nbErr Then
        Set re = r.Find(1, LookIn:=xlValues, lookat:=xlWhole)
        If Not re Is Nothing Then
            pa = re.Address
            Do
                st = st & " " & re.Address
                Set re = r.FindNext(re)
            Loop While re.Address <> pa

            MsgBox "Vous avez " & nbErr & " anomalie(s), vérifier les cellules qui sont sur la meme ligne que la(les) cellule(s) orange." & st, , "Oups, il y a erreur."
        End If
    End If
    If nbErr = 0 Then ActiveWorkbook.Save

    MsgBox "Il n'y a pas de différences, le fichier va fermer"
    ActiveWorkbook.Close

End Sub

Bonjour H2SO4,

Ton code fonctionne très bien. Le seul hic, c'est que j'aurais besoin de récupérer les adresses une à la fois. J'en aurai besoin plus tard.

J'ai essayé de les extraire de la variable st mais je n'ai pas réussi.

Un gros merci

Claire

Bonjour,

J'avais prévu de mettre les cellules en fond rouge.

la macro est : ComparePlages()

A tester.

bonjour,

bonjour Jean-Eric

j'ai modifié le code pour te mettre les adresses dans la variable string "st" et dans un tableau "ad()"

Sub essai()
    Dim ad As Variant
    Dim nbErr As Long
    Set r = Range("W2:" & Range("AF" & Rows.Count).End(xlUp).Address)
    nbErr = Application.CountIf(r, 1)
    pa = ""
    sep = ""
    If nbErr Then
        Set re = r.Find(1, LookIn:=xlValues, lookat:=xlWhole)
        If Not re Is Nothing Then
            pa = re.Address
            Do
                st = st & sep & re.Address
                If sep = "" Then sep = " "
                Set re = r.FindNext(re)
            Loop While re.Address <> pa
            ad = Split(st, " ")
            For i = LBound(ad) To UBound(ad)
            MsgBox ad(i)
            Next i
            MsgBox "Vous avez " & nbErr & " anomalie(s), vérifier les cellules qui sont sur la meme ligne que la(les) cellule(s) orange." & st, , "Oups, il y a erreur."
        End If
    End If
    If nbErr = 0 Then ActiveWorkbook.Save

    MsgBox "Il n'y a pas de différences, le fichier va fermer"
    ActiveWorkbook.Close

End Sub

Bonjour h2so4,

Bonjour Jean-Eric,

Vos deux suggestions sont bonnes, j'essaie de les combiner.

Jean-Eric, ta macro trouve seulement 1 anomalie lorsque j'en ai plusieurs.

J'ai essayé de trouver mais je n'ai pas pu.

Merci

Claire

Bonjour,

Code corrigé

Public Sub ComparePlages()  'Jean-Eric
Dim Arr1, _
    Arr2, _
    Flag As Boolean, _
    i As Long, j As Long, _
    cpt As Long

    Cells.Interior.Color = xlNone
    Application.ScreenUpdating = False
    Arr1 = Range("A2:J54").Value
    Arr2 = Range("L2:U54").Value
    Flag = True

    For i = LBound(Arr1, 2) To UBound(Arr1, 2)
        For j = LBound(Arr1, 1) To UBound(Arr1, 1)
            Debug.Print Cells(j + 1, i).Address & "-" & Cells(j + 1, i + 11).Address
            If Not CCur(Arr1(j, i)) = CCur(Arr2(j, i)) Then
                Flag = False
                Cells(j + 1, i).Interior.Color = RGB(255, 0, 0)
                Cells(j + 1, i + 11).Interior.Color = RGB(255, 0, 0)
                cpt = cpt + 1
            End If
        Next j
    Next i

    If cpt > 0 Then
        MsgBox "Vous avez " & cpt & " anomalies(s)." _
            & Chr(10) & "Les cellules sont mises en évidence.", 16
    Else
        MsgBox "Les 2 plages sont identiques.", 64
    End If

End Sub

Bonjour h2so4,

Bonjour Jean-Eric,

Mon problème est résolu grâce à vous deux. J'ai dû cocher un seulement mais j'aurais voulu en cocher deux.

Un gros merci et une bonne fin de semaine.

Claire