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

[MaximeC]

Bonjour,

Dans le cadre d'un emploie saisonnier, on m'a demandé de réaliser une macro afin de comparer des données... Ayant très peu de base en VBA (si ce n'est un cours ayant eu pour objet la création de userform afin de réaliser des expériences probabilistes), je me tourne vers vous afin de m'orienter dans cette réalisation.

L'objectif est de trouver si il y en a, des similitudes entre une colonne de base B (environ 7500 lignes) et des données actualisées régulièrement à inserer (par moi même) dans le même fichier excel, colonne R (nombre de lignes variables ... maximum 500).

L'autre but étant de repérer facilement les similtudes, serait-il possible de mettre en couleur les lignes des cellules identiques au fichier importer? (une couleur par référence, jusqu'à la colonne P).

D'autre part, il y a 3 typeS de références à comparer, séparées dans 3 colonnes distinctes. Est-il possible de réaliser les demandes ci dessus sur chacune des colonnes (B,C et F)?

Enfin, afin de faciliter l'utilisation future de mes collègues, il me semble qu'il est possible de créer un bouton de commande afin de lancer chacun des 3 programmes. Pouvez vous les réaliser?

Dans l'attente de vos réponses, je vous souhaite une agréable journée.

Merci, et bon courage.

Maxime

 

[MaximeC]

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 :

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]

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]

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]

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

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]

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

 

[MaximeC]

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

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:

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]

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:

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.

 

[MaximeC]

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

Finalement j'opte pour cette solution :

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]

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

Si tu veux...

 

[MaximeC]

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]

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.

 

[MaximeC]

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

merci bien ^^

 

[leop93]

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.

 

[MaximeC]

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

Comment fais tu?

 

[leop93]

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.