[XL-2007] Macro : "Au moins deux cellules identiques alors "

Macro : "Au moins deux cellules identiques alors "

Bonjour,

Je souhaiterais créer une macro avec la fonction Si et que si il y a dans ma plage deux cellules identiques alors ..

Je ne sais pas comment faire, à part comparer chaque cellule aux autres, mais c'est un peu long.. Pouvez-vous m'aider s'il vous plait ?

Bonne soirée

Bonjour,

Un exemple ci-dessous à partir d'une grille sudoku.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
Option Explicit
 
Public MatriceAireEtudiee() As Variant
Public Sh As Worksheet
Public AireEtudiee As Range
Public CelluleEtudiee As Range
 
Sub ComparaisonCellules()
 
Dim X As Long
Dim Y As Long
Dim ListeCellulesIdentiques As String
Dim Continuer As Boolean
 
    Set Sh = Sheets("Feuil1")
    Set AireEtudiee = Sh.Range("GrilleSudoku")
 
 
    ReDim MatriceAireEtudiee(AireEtudiee.Columns.Count - 1, AireEtudiee.Rows.Count - 1)
 
    For X = 0 To AireEtudiee.Columns.Count - 1
        For Y = 0 To AireEtudiee.Rows.Count - 1
             MatriceAireEtudiee(X, Y) = AireEtudiee.Cells(Y + 1, X + 1)
        Next Y
    Next X
 
    ListeCellulesIdentiques = ""
    Continuer = True
    For Y = LBound(MatriceAireEtudiee, 2) To UBound(MatriceAireEtudiee, 2)
            For X = LBound(MatriceAireEtudiee, 1) To UBound(MatriceAireEtudiee, 1)
                    For Each CelluleEtudiee In AireEtudiee
                        If CelluleEtudiee.Address <> AireEtudiee.Cells(Y + 1, X + 1).Address And CelluleEtudiee <> "" Then
                           If CelluleEtudiee = MatriceAireEtudiee(X, Y) Then
                                     ListeCellulesIdentiques = ListeCellulesIdentiques & "Adresse matrice : " & AireEtudiee.Cells(Y + 1, X + 1).Address _
                                                    & " Valeur : " & MatriceAireEtudiee(X, Y) _
                                                    & " - Adresse grille : " & CelluleEtudiee.Address & " Valeur : " & CelluleEtudiee & Chr(10)
                                     Continuer = False ' A supprimer pour obtenir la totalité des cas
                                     Exit For          ' A supprimer pour obtenir la totalité des cas
                            End If
                         End If
                    Next CelluleEtudiee
                    If Continuer = False Then Exit For ' A supprimer pour obtenir la totalité des cas
            Next X
            If Continuer = False Then Exit For ' A supprimer pour obtenir la totalité des cas
    Next Y
 
    MsgBox (ListeCellulesIdentiques)
 
    Set AireEtudiee = Nothing
    Set Sh = Nothing
 
 
End Sub

Cordialement.

Un peu de retard, mais merci !
Cela me parait un peu compliqué, non ?
Le cas que j'ai est plus simple puisque ma plage est une colonne de 8 lignes seulement .. Du coup je ne vois pas trop comment le mettre en forme surtout que moi ce n'est pas des chiffres. :?