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

 

[leop93]

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

D'accord, j'ai ajouté encore un petit truc à mettre en place, au moins pour la propreté.

C'était pour te taquiner l'ultérieurement. Et non tu ne l'avais pas précisé après vérification.

 

[MaximeC]

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

A quoi serve Application.ScreenUpdating = True et Application.ScreenUpdating = False??

 

[MaximeC]

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

Afin de me faciliter la tache, j'ai créé une colonne sur la même feuille avec les données à comparer ...

Sur mon deuxième message ...

 

[leop93]

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

Applique le et tu le découvriras.

Si jamais tu n'arrives pas à les mettre au bon endroit:

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 = 1
For k = 3 To Cells(500, 18).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(500, 18).End(xlUp).Row ' Parcours des données recensées
  
            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
                    'm = m + 1 ' Changement de couleur
                Next j
               Cells(k, 18).Interior.ColorIndex = 5
            End If
        
    Next i
    
Next k

Application.ScreenUpdating = True

End Sub

EDIT: je ne vois pas où mais peu importe, l'important c'est le code !

 

[Dranreb]

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

Dans ce cas, à la lueur du dernier fichier joint, pourquoi pas sur A335 une mise en forme conditionnelle avec cette formule ?

=NB.SI($R$3:$R$35;$B3)>0

À +

 

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


For k = 3 To Cells(500, 18).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(7433, 2).End(xlUp).Row ' Parcours des données recensées

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

Next i

Next k

Application.ScreenUpdating = True

End Sub


Je ne vois pas la différence, tout du moins sur le résultat obtenu ... Je pense que c'est sur la rapidité d'éxecution mais je ne suis pas sure ...

Est ce que la nouvelle explication est-elle plus claire?

 

[leop93]

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

Pour plus de lisibilité, met ton code entre balise [*code=vba] CODE [*/code], sans les étoiles.

Pour ma part l'explication était comprise depuis le début (via l'interprétation que j'en faisais), mais parfois ce que tu disais mettait vraiment des grosses zones de floues...

Le Application.ScreenUpdating fait que toutes les actions du code sont faites et ensuite elles sont affichées. Evitant ainsi le "clignotement" lors de l'éxécution du code.

Une autre chose me saute aux yeux, pourquoi t'entêtes tu à mettre des valeurs exactes dans les For i = 3 to CETTE VALEUR ? Le End(xlUp).Row permet de ne sélectionner que les lignes remplies si je ne m'abuse, donc tu devrais mettre la valeur max, c'est à dire 65536. 2 je suppose que c'est B, 18 je suppose que c'est R. Pour les deux remplace par:

For i = 3 To [B65536].End(xlUp).Row
For k = 3 To [R65536].End(xlUp).Row

 

[MaximeC]

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

Comment fais tu avec le ci joint? pk 65536? j'ai que 7433 lignes max?

 

[leop93]

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

Tu vas sur ce site, tu upload ton fichier et tu nous copie/colle le lien: Accueil de Cjoint.com

65536 = 16 bits, valeur maximale pour un entier sous Excel et sous beaucoup de logiciel. Pas sûr à 100% mais ça doit être quelque chose comme ça.

Tu as que 7433 lignes, mais ça c'est pour le moment. Je suppose que c'est une sorte de base de donnée qui sera complétée au fur et à mesure. Ca serait bête que ta macro se stoppe à la 7433ème ligne alors qu'il y en a 7435...

Et la fonction que je t'ai donné se stoppe quand les cellules sont vides, donc pas de travail pour rien et donc gain de temps, ressource, vitesse, ... .

 

[MaximeC]

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

L'entreprise ou je travaille a bloqué le site ... Pas de bol ..

 

[MaximeC]

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

 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]

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

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]

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

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]

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]

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