Mettre en évidence des similitudes entre 2 colonnes Excel [VBA]

MaximeC

XLDnaute Junior
Re : Mettre en evidence des similutes entre 2 feuilles excel, a l'aide d'1 programme

Comme vous avez pu le voir sur le fichier que je viens de vous joindre test_2 il me semble, j'ai réussi, enfin vous avez réussi à me faire colorier les lignes .. J'ai essayé ci dessous d'atribuer une couleur à chaque référence nouvelle, de façon a reperer facilement les similitudes entre colonne A et et R. cependant j'ai une erreur au niveau du Next j ( en gras ) j'arrive pas à voir ce que c'est ..


Code:
 Private Sub CommandButton1_Click()

'INITIALISATION

Dim i As Long ' Lignes de la colonne A
Dim j As Long ' Colonne A à Colonne P
Dim k As Long ' Lignes de la colonne O
Dim m As Single ' Changment de couleur

Application.ScreenUpdating = False
' PROGRAMME
m = 3

For k = 3 To Cells(B65536).End(xlUp).Row  ' jusqu'à la derniére ligne non vide; .End(xlUp).Row: la ligne de la première cellule non vide en remontant depuis la dernière ligne de la colonne.


    For i = 3 To Cells(R65536).End(xlUp).Row
            If Cells(k, 18).Value = Cells(i, 2).Value And Cells(i, 2).Value <> "" And Cells(k, 18).Value <> "" Then 'Recherche des similitudes en évitant les cellules non vides ..
                Do While Cells(k, 18).Value = Cells(i, 2).Value ' Tant que la cellule comparée est identique à la cellule de base, l'arrière plan est identique
                    For j = 1 To 16
                        Cells(i, j).Interior.ColorIndex = m ' Colorie la ligne
                    [B]Next j[/B]   
                     Cells(k, 18).Interior.ColorIndex = m ' Colorie la cellule de base
                Loop
                m = m + 1 ' Change de couleur
            End If
    Next i
    
Next k

Application.ScreenUpdating = True

End Sub
 

leop93

XLDnaute Occasionnel
Re : Mettre en evidence des similutes entre 2 feuilles excel, a l'aide d'1 programme

Tu n'appliques même pas ce que je te dis... Un simple copier/coller quoi...
Code:
For i = 3 To [B65536].End(xlUp).Row
For k = 3 To [R65536].End(xlUp).Row
Et je suppose que tu parles de test_3 et non test_2, que tu as joint page 2... Ou alors tu as eu un raté dans l'ajout de fichier dans ton dernier message...

Après il faut que tu vérifies si ça fonctionne avec le code que je t'ai donné, sinon il faudra un peu bidouiller. Ca fonctionne sur mon classeur. Mâis je crois qu'il faut modifier ce que je t'ai donné pour les For To. Je repasse demain.

Mais tu auras peut être trouvé d'ici demain. ;)
 

Dranreb

XLDnaute Barbatruc
Re : Mettre en evidence des similutes entre 2 feuilles excel, a l'aide d'1 programme

VB:
Private Sub CommandButton1_Click()
With Me.Range("A3:P" & Me.[B65536].End(xlUp).Row).FormatConditions
  .Delete
   Me.[A3].Select
  .Add(Type:=xlExpression, Formula1:="=NB.SI($R$3:$R$" & Me.[R65536].End(xlUp).Row _
      & ";$B3)>0").Interior.ColorIndex = 3
  End With
End Sub
À +
 

MaximeC

XLDnaute Junior
Re : Mettre en evidence des similutes entre 2 feuilles excel, a l'aide d'1 programme

Merci, mais ... ton programme ne colorie pas les références de base: colonne R ( ce qu'on a réussit a faire avec leop93) . Maintenant j'essaie de mettre une couleur par référence ..

Bonne journée
 

leop93

XLDnaute Occasionnel
Re : Mettre en evidence des similutes entre 2 feuilles excel, a l'aide d'1 programme

Bonjour Maxime

Pourras tu ce matin uploader ton classeur actuel pour avoir le "code fonctionnel" que tu souhaites modifier pour changer les couleurs.

Comme ça pas de quiproquo, on pourra t'aider exactement sur ce que tu travailles. ;)

Bonne journée

Leop93
 

MaximeC

XLDnaute Junior
Re : Mettre en evidence des similutes entre 2 feuilles excel, a l'aide d'1 programme

Voici le code obtenu hier gràce à votre aide :

Code:
Private Sub CommandButton1_Click()


'INITIALISATION

Dim i As Long ' Lignes de la colonne B
Dim j As Long ' Colonne A à Colonne P
Dim k As Long ' Lignes de la colonne R
Dim m As Single ' Changment de couleur
Dim reference As String ' tockage de la référence
Dim n As Long

Application.ScreenUpdating = False
' PROGRAMME

    'm = 3
For k = 3 To [R65536].End(xlUp).Row  ' Parcours la colonne R
    For i = 3 To [B65536].End(xlUp).Row  ' Parcours des données recensées sauf les cellules non remplies
        If Cells(k, 18).Value = Cells(i, 2).Value And Cells(i, 2).Value <> "" And Cells(k, 18).Value <> "" Then 'Recherche des similitudes en évitant les cellules non vides ..
                For j = 1 To 16 ' pour les colonnes de A à P de la ligne i, on colorie l'ensemble des cellules similaire à la cellule comparée
                    Cells(i, j).Interior.ColorIndex = 5 ' Changement de couleur
                Next j
                Cells(k, 18).Interior.ColorIndex = 5
            End If
      'm = m + 1
    Next i
    
Next k

Application.ScreenUpdating = True

End Sub
 

leop93

XLDnaute Occasionnel
Re : Mettre en evidence des similutes entre 2 feuilles excel, a l'aide d'1 programme

Merci, ça se profile déjà bien.

Il ne reste plus qu'à essayer de modifier la valeur de la couleur.

Je pense qu'il ne faudra pas passer par un Interior.ColorIndex (car nombre de couleur limité je crois) mais plutôt par un Interior.Color = RGB(ValRouge, ValVert, ValBleu).

Tu devrais essayer de regarder du côté d'une incrémentation de chaque valeur à chaque nouveau doublon. Ou alors de définir des couleurs et de les appeler chacune leur tour automatiquement.

Une trentaines de couleurs devraient largement suffire puisqu'elles seront appelées dans un ordre précis facilement repérable.
 

MaximeC

XLDnaute Junior
Re : Mettre en evidence des similutes entre 2 feuilles excel, a l'aide d'1 programme

Je viens de travailler dessus pour les couleurs ...
Je suis parti sur le fait que dés que je trouve une similitude, je colorie la ligne de la cellule similaire a la ligne i et la référence de base, PUIS je stock la chaine de caractère dans une variable, en parcourant, à partir de la cellule i+1 la reste de la colonne. lorsque que ma variable stocké est identique a la cellule parcourue, alors je colorie, uniquement!!, la ligne de cette celulle ..

( Est ce clair?? ^^)
Voici le code que j'ai fait ce matin, mais il m'affiche une erreur 1004 et je le trouve un peu lourd, non?
 

MaximeC

XLDnaute Junior
Re : Mettre en evidence des similutes entre 2 feuilles excel, a l'aide d'1 programme

Code:
Private Sub CommandButton1_Click()


'INITIALISATION

Dim i As Long ' Lignes de la colonne B
Dim j As Long ' Colonne A à Colonne P
Dim k As Long ' Lignes de la colonne R
Dim m As Single ' Changment de couleur
Dim reference As String ' Stockage de la référence
Dim n As Long

Application.ScreenUpdating = False
' PROGRAMME

    m = 3
For k = 3 To [R65536].End(xlUp).Row  ' Parcours la colonne R
    For i = 3 To [B65536].End(xlUp).Row  ' Parcours des données recensées sauf les cellules non remplies
        If Cells(k, 18).Value = Cells(i, 2).Value And Cells(i, 2).Value <> "" And Cells(k, 18).Value <> "" Then 'Recherche des similitudes en évitant les cellules non vides ..
                For j = 1 To 16 ' Pour les colonnes de A à P de la ligne i, on colorie l'ensemble des cellules similaire à la cellule comparée
                    Cells(i, j).Interior.ColorIndex = m ' Changement de couleur
                Next j
                Cells(k, 18).Interior.ColorIndex = m
                reference = Cells(k, 18).Value ' Le but est d'attribuer une couleur par référence
                i = i + 1
                    For n = i To [B65536].End(xlUp).Row ' Parcours de la colonne B à partir de la référence trouvée
                        If Cells(i, 2).Value = reference Then
                                For j = 1 To 16
                                    Cells(i, j).Interior.ColorIndex = m
                                Next j
                        End If
                    Next n
            End If
      m = m + 1
    Next i
Next k

Application.ScreenUpdating = True

End Sub
 

MaximeC

XLDnaute Junior
Re : Mettre en evidence des similutes entre 2 feuilles excel, a l'aide d'1 programme

"Je pense qu'il ne faudra pas passer par un Interior.ColorIndex (car nombre de couleur limité je crois) mais plutôt par un Interior.Color = RGB(ValRouge, ValVert, ValBleu)."

J'approuve cette idée, puisque à l'instant mon chef vient de m'indiquer que le bleu ( code couleur 5 ) était un peu trop foncé! ( on ne distingue pas les références) Ca serait cool si je pouvais réussir à choisir les couleurs ;)
 
Dernière édition:

MaximeC

XLDnaute Junior
Re : Mettre en evidence des similutes entre 2 feuilles excel, a l'aide d'1 programme

Afin de gagner en clarté , est -il possible de remplacer
Code:
For i = 3 To [B65536].End(xlUp).Row  ' Parcours des données recensées sauf les cellules non remplies
        If Cells(k, 18).Value = Cells(i, 2).Value And Cells(i, 2).Value <> "" And Cells(k, 18).Value <> "" Then 'Recherche des similitudes en évitant les cellules non vides ..
                For j = 1 To 16 ' pour les colonnes de A à P de la ligne i, on colorie l'ensemble des cellules similaire à la cellule comparée
                    Cells(i, j).Interior.ColorIndex = 5 ' Changement de couleur
                Next j

par:

Code:
For i = 3 To [B65536].End(xlUp).Row 
If Cells(k, 18).Value = Cells(i, 2).Value And Cells(i, 2).Value <> "" And Cells(k, 18).Value <> "" Then     
Range(Ai,Pi).Interior.ColorIndex = 5 ' Changement de couleur
 

leop93

XLDnaute Occasionnel
Re : Mettre en evidence des similutes entre 2 feuilles excel, a l'aide d'1 programme

Il faut que tu essayes, si tu vois que ça ne fonctionne pas, c'est que tu ne peux pas.

Mais je pense que tu vas devoir faire:
Code:
Range("A"& i, "P"& i).Interior.Color=RGB(Val1, Val2, Val3)
ou quelque chose comme ça. ;) (pas sûr de l'écriture par rapport à ce que tu veux faire)

EDIT: testé à l'instant, c'est la bonne écriture, plus qu'à adapter comme tu le souhaites.

Sinon, en attendant de gérer au mieux la couleur, remplace ton indice de couleur 5 par 8, tu resteras sur du bleu mais tu pourras lire tes références.
 
Dernière édition:

MaximeC

XLDnaute Junior
Re : Mettre en evidence des similutes entre 2 feuilles excel, a l'aide d'1 programme

Finalement j'opte pour cette solution :

Code:
Private Sub CommandButton1_Click()

  Worksheets(1).Range(Cells(3, 1), Cells(7433, 18)).Interior.ColorIndex = 0
'INITIALISATION

Dim i As Long ' Lignes de la colonne B
Dim j As Long ' Colonne A à Colonne P
Dim k As Long ' Lignes de la colonne R
Dim m As Single ' Changment de couleur
Dim reference As String ' tockage de la référence
Dim n As Long

Application.ScreenUpdating = False
' PROGRAMME

    
For k = 3 To [R65536].End(xlUp).Row  ' Parcours la colonne R
    For i = 3 To [B65536].End(xlUp).Row  ' Parcours des données recensées sauf les cellules non remplies
    
        If Cells(k, 18).Value = Cells(i, 2).Value And Cells(i, 2).Value <> "" And Cells(k, 18).Value <> "" Then 'Recherche des similitudes en évitant les cellules non vides ..
            Worksheets(1).Range(Cells(i, 1), Cells(i, 16)).Interior.ColorIndex = 5
            Cells(k, 18).Interior.ColorIndex = 5
        End If
      
    Next i
    
Next k

Application.ScreenUpdating = True

End Sub
 

leop93

XLDnaute Occasionnel
Re : Mettre en evidence des similutes entre 2 feuilles excel, a l'aide d'1 programme

Si tu veux...
 

MaximeC

XLDnaute Junior
Re : Mettre en evidence des similutes entre 2 feuilles excel, a l'aide d'1 programme

C'est pas mieux? Enfin je ne vais pas gagner en rapidité?
 

leop93

XLDnaute Occasionnel
Re : Mettre en evidence des similutes entre 2 feuilles excel, a l'aide d'1 programme

Je ne sais pas. Et dans tes commentaires, je pense que tu veux dire "en évitant les cellules vides" et non pas non vides.
 

leop93

XLDnaute Occasionnel
Re : Mettre en evidence des similutes entre 2 feuilles excel, a l'aide d'1 programme

De rien.

Et si je peux me permettre, tu devrais changer ton titre par:
Mettre en évidence des similitudes entre 2 feuilles Excel [VBA]
Car il n'est pas très agréable à lire, trop compliqué et sans parler des fautes qui piquent, voir font saigner les yeux. :rolleyes:
 

leop93

XLDnaute Occasionnel
Re : Mettre en evidence des similutes entre 2 feuilles excel, a l'aide d'1 programme

Comme quand tu modifies tes messages (tu l'as fait message #50) sauf que tu le fais sur le tout premier du topic. ;)

EDIT: quel beau titre. :eek:
 
Dernière édition:

Haut Bas