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 |
Partager