comparer 3 plages de cellules

[mumu]

Bonjour à tous,

Je viens de fouiller le site sans trop de solutions à mon problème....
J'ai définie des plages de cellules (qui n'ont pas les mêmes dimensions) plage 1 à 9.
Je cherche à souligner en couleur les lignes pour lesquelles les valeurs sont identiques pour 3 plages de cellules
plage1/plage4/plage7
plage2/plage5/plage8
plage3/plage6/plage9

Le résultat que je cherche est en pièce jointe.

Voici le bout de code que j'ai commencé à écrire pour mes plages de cellules mais j'avoue que je n'ai pas de méthode pour comparer 3 plages entre elles.

Quelqu'un aurait-il une piste ?

'Définition des plages à comparer
Dim plage1, plage2, plage3 As String
Dim plage4, plage5, plage6 As String
Dim plage7, plage8, plage9 As String
Dim DLa, DLi, DLq As Integer

DLa = Sheets("esti_autrsect").Range("A" & Rows.Count).End(xlUp).Row
DLi = Sheets("esti_autrsect").Range("I" & Rows.Count).End(xlUp).Row
DLq = Sheets("esti_autrsect").Range("Q" & Rows.Count).End(xlUp).Row

Dim f As Range
For Each f In Sheets("esti_autrsect").Range("A17:A" & DLa)
If f.Value = "< 12 m" Then plage1 = Sheets("esti_autrsect").Range(f.Offset(0, 1), f.Offset(1, 1).End(xlDown)).Address
If f.Value = ">= 17 m" Then plage2 = Sheets("esti_autrsect").Range(f.Offset(0, 1), f.Offset(1, 1).End(xlDown)).Address
If f.Value = "12 - 16,9 m" Then plage3 = Sheets("esti_autrsect").Range(f.Offset(0, 1), f.Offset(1, 1).End(xlDown)).Address
Next f

Dim g As Range
For Each g In Sheets("esti_autrsect").Range("I17:I" & DLi)
If g.Value = "< 12 m" Then plage4 = Sheets("esti_autrsect").Range(g.Offset(0, 1), g.Offset(1, 1).End(xlDown)).Address
If g.Value = ">= 17 m" Then plage5 = Sheets("esti_autrsect").Range(g.Offset(0, 1), g.Offset(1, 1).End(xlDown)).Address
If g.Value = "12 - 16,9 m" Then plage6 = Sheets("esti_autrsect").Range(g.Offset(0, 1), g.Offset(1, 1).End(xlDown)).Address
Next g

Dim h As Range
For Each h In Sheets("esti_autrsect").Range("Q17:Q" & DLq)
If h.Value = "< 12 m" Then plage7 = Sheets("esti_autrsect").Range(h.Offset(0, 1), h.Offset(1, 1).End(xlDown)).Address
If h.Value = ">= 17 m" Then plage8 = Sheets("esti_autrsect").Range(h.Offset(0, 1), h.Offset(1, 1).End(xlDown)).Address
If h.Value = "12 - 16,9 m" Then plage9 = Sheets("esti_autrsect").Range(h.Offset(0, 1), h.Offset(1, 1).End(xlDown)).Address
Next h

D'avance merci !!!!

Mumu

 

[suistrop]

Re : comparer 3 plages de cellules

Salut,

Regarde cette macro et ce fichier :

Sub ike()
'Pour le premier tableau en bleu < 12 m
tab_1_col = 2
tab_1_lig = 2
tab_2_col = 10
tab_2_lig = 2
tab_3_col = 18
tab_3_lig = 2
For x1 = tab_1_lig To Range(Cells(tab_1_lig, tab_1_col), Cells(tab_1_lig, tab_1_col)).End(xlDown).Row
compare = Cells(x1, tab_1_col)
trouver = False
For x2 = tab_2_lig To Range(Cells(tab_2_lig, tab_2_col), Cells(tab_2_lig, tab_2_col)).End(xlDown).Row
If Cells(x2, tab_2_col) = compare Then
For x3 = tab_3_lig To Range(Cells(tab_3_lig, tab_3_col), Cells(tab_3_lig, tab_3_col)).End(xlDown).Row
If Cells(x3, tab_3_col) = compare Then
trouver = True
ligne_x3 = x3
End If
Next x3
ligne_x2 = x2
End If
t = Cells(x2, tab_2_col)
Next x2
If trouver = True Then
Cells(x1, tab_1_col + 1) = 1
Cells(ligne_x2, tab_2_col + 1) = 1
Cells(ligne_x3, tab_3_col + 1) = 1
End If
Next x1
End Sub

J'ai mis des 1 sur les lignes mais tu peux faire ce que tu veux avec.
Je n'ai traiter que la premiere partie du tableau, pour traiter les autres, change les parametres en début de macro.


Suistrop

 

[mumu]

Re : comparer 3 plages de cellules

Salut Suistrop,

Je te remercie pour cette réponse.
Je viens de tester ta macro et elle me paraît très intéressante. Va falloir que je l'adapte mais c'est ce que je voulais dans l'esprit ! car je vais plutôt y mettre de la couleur.
Je te tiens au courant dès que je la finalise.
A +

Mumu

 

[suistrop]

Re : comparer 3 plages de cellules

Hello,

Tant mieux si ca te convient, bonne chance pour les modifications.

Suistrop

 

[Bebere]

Re : comparer 3 plages de cellules

Bonjour Mumu,Suistrop
une autre proposition
code module1
à bientôt

 

[mumu]

Re : comparer 3 plages de cellules

Bonjour Bebere,

Je te remercie d'avoir pris le temps de regarder mais ton code ne me donne pas vraiment ce que je recherche. En fait je voudrais surligner uniquement les cellules identiques et de la même couleur pour chacun des blocs.
Mais je vais essayer d'adapter tout ça et je vous tiens au courant.

A +

Mumu

 

[mumu]

Re : comparer 3 plages de cellules

Salut,

Et bien grâce à vos conseils et surtout a toi Suistrop voici un bout de la macro pour le deuxième bloc de mes données. C'est juste pour info car je suis arrivée à mes fins !!!!
Merci encore et à bientôt.
Mumu

'Pour le deuxième tableau en vert >= 17 m
Dim f As Range
For Each f In Sheets("esti_autrsect").Range("A17:A" & DLa)
If f.Value = ">= 17 m" Then T4_L = f.Offset(0, 1).Row
Next f
Dim g As Range
For Each g In Sheets("esti_autrsect").Range("I17:I" & DLi)
If g.Value = ">= 17 m" Then T5_L = g.Offset(0, 1).Row
Next g
Dim h As Range
For Each h In Sheets("esti_autrsect").Range("Q17:Q" & DLq)
If h.Value = ">= 17 m" Then T6_L = h.Offset(0, 1).Row
Next h

For x1 = T4_L To Range(Cells(T4_L, T1_C), Cells(T4_L, T1_C)).End(xlDown).Row
compare = Cells(x1, T1_C)
trouver = False
For x2 = T5_L To Range(Cells(T5_L, T2_C), Cells(T5_L, T2_C)).End(xlDown).Row
If Cells(x2, T2_C) = compare Then
For x3 = T6_L To Range(Cells(T6_L, T3_C), Cells(T6_L, T3_C)).End(xlDown).Row
If Cells(x3, T3_C) = compare Then
trouver = True
ligne_x3 = x3
End If
Next x3
ligne_x2 = x2
End If
t = Cells(x2, T2_C)
Next x2
If trouver = True Then
Range(Cells(x1, T1_C + 1).Offset(0, -1), Cells(x1, T1_C + 1).Offset(0, 3)).Interior.ColorIndex = 35
Range(Cells(ligne_x2, T2_C + 1).Offset(0, -1), Cells(ligne_x2, T2_C + 1).Offset(0, 3)).Interior.ColorIndex = 35
Range(Cells(ligne_x3, T3_C + 1).Offset(0, -1), Cells(ligne_x3, T3_C + 1).Offset(0, 3)).Interior.ColorIndex = 35
End If
Next x1