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

MaximeC

XLDnaute Junior
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
 
Dernière édition:

MaximeC

XLDnaute Junior
Re : Mettre en évidence des similitudes entre 2 colonnes Excel [VBA]

Bonjour,

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

J'ai ainsi pu écrire le code suivant:
Private Sub CommandButton1_Click()

Dim i As Single ' Lignes de la colonne A
Dim j As Single ' Colonne A
Dim k As Single ' Lignes de la colonne O

For k = 3 To 500 'Parcours de la colonne à comparer
Do While Cells(k, 18).Value <> "" ' Tant que la cellule est différent de " vide " faire :
For i = 3 To 7433 ' Parcours des données recensées
If Cells(k, 18).Value = Cells(i, 2).Value Then ' Si les cellules comparées sont identiques, alors :
For j = 1 To 16 ' pour les colonnes de A à O de la ligne i, on colorie l'ensemble des cellules
Cells(i, j).Interior.ColorIndex = 3
Next j
End If
Next i
Loop
Next k

End Sub

Cependant lorsque je lance mon bouton de commande, le fichier ne répond plus ... Cela peut il venir du grand nombre de données?

Il y a t-il des erreurs dans ce code? Je ne pense pas que l'instruction servant à colorier les cellules soit la bonne puisque le but est de colorier l'arrière plan et non la cellule elle même.

Merci ,

Maxime
 
Dernière édition:

leop93

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

Salut

Toi aussi tu as la chance dans ton travail saisonnier de découvrir un nouveau langage... :rolleyes:

J'en suis à 2 semaines de programmation pour automatiser la gestion de la production (chef de projet / dessinateur / mécanicien) d'une assez grande entreprise... Et je n'ai pas encore fini...

Bonne chance :eek:

Leop93
 

Dranreb

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

Bonjour.
k ne changeant pas lors d'un passage dans la boucle For k, pourquoi voudriez vous que le Do While qu'il contient s'arrête ?
À +
 

MaximeC

XLDnaute Junior
Re : Mettre en évidence des similitudes entre 2 colonnes Excel [VBA]

Cela me parraisait bizarre en effet ... je voulais juste éviter de parcourir les 500 lignes, pour éviter que le programme tourne pour rien ... Voyez vous une solution à ce problème? Suis-je obliger de parcourir les 500 lignes?

Bon courage à toi Leop93!


Merci
 
Dernière édition:

Dranreb

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

Ah ! Il ne faut pas de Do While alors: S'il devient inutile de continuer à parcourir la boucle faire Exit For
À +
 

leop93

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

Merci.

Je ne sais pas si ça peut t'aider, mais on m'a conseillé de modifier ma boucle For par ceci car beaucoup trop longue, maintenant ça va à la vitesse de la lumière... Ou presque. ;)

Code:
Sub taFonction()

Dim i&    
      For i = 0 To [I65536].End(xlUp).Row

'TON CODE

Next

End sub
 

MaximeC

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

Est ce mieux?
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

' PROGRAMME

For k = 3 To 500 'Parcours de la colonne à comparer

If Cells(k, 18).Value <> "" Then ' Tant que la cellule est différent de " vide " faire :

For i = 3 To 7433 ' Parcours des données recensées

If Cells(k, 18).Value = Cells(i, 2).Value & Cells(i, 2).Value <> "" & Cells(k, 18).Value <> "" Then ' Si les cellules comparées sont identiques et non vide, alors :

For j = 1 To 16 ' pour les colonnes de A à P de la ligne i, on colorie l'ensemble des cellules
Cells(i, j).Interior.ColorIndex = 6
Next j
End If
Next i
Else
Exit For
End If
Next k

End Sub

MErci :)
 

Dranreb

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

Non :
VB:
If Cells(k, 18).Value "" Then Exit For '
Mais la solution style leop93 est bien aussi.:
VB:
For k = 3 To Cells(65536, 18).End(xlUp).Row
P.S. Oui: .End(xlUp).Row: la ligne de la première cellule non vide en remontant depuis la dernière ligne de la colonne.
À +
 
Dernière édition:

MaximeC

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

Malheureusement, cela ne fonctionne pas...
1°) il m'affiche un message d'erreur "1004" : surement due au "m" qui est censé définir la couleur : je souhaite changé de couleur pour différencier les similitudes
2°) Lorsqu'il n'y a pas le message d'erreur, toutes les lignes sont coloriées ....

voila ce que ca donne :
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

' PROGRAMME

m = 1
For k = 3 To Cells(500, 18).End(xlUp).Row ' jusqu'à la derniére ligne non vide :
For i = 3 To 7433 ' Parcours des données recensées
If Cells(k, 18).Value = Cells(i, 2).Value & Cells(i, 2).Value <> "" & Cells(k, 18).Value <> "" Then 'Recherche des similitudes en évitant les cellules non vides ..
For j = 1 To 18 ' 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
m = m + 1 ' Changement de couleur
Next j ' Si les cellules comparées sont identiques et non vide, alors :
End If
Next i
Next k

End Sub

Merci
 

MaximeC

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

D'autre part, à chaque fois que je lance le bouton de commande, le fichier finit par ne plus répondre ..
 

leop93

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

Je me suis penché 2 minutes sur ton fichier, voici ce que je t'ai fait:

Code:
Sub Doublons()
Dim r As Range, ncol%, d As Object, t$, col%, doublon As Range
Set r = [B:B] 'zone comparée - Ici cellule B / Mets [A:F] si tu veux que la ligne entière soit comparée
Set r = Intersect(r, ActiveSheet.UsedRange)
If r Is Nothing Then Exit Sub
ncol = r.Columns.Count
Set d = CreateObject("Scripting.Dictionary")
For Each r In r.Rows
  t = ""
  For col = 1 To ncol
    t = t & r.Cells(col) & Chr(1)
  Next
  t = UCase(Application.Trim(t))
  If d.Exists(t) Then
    Set doublon = Union(IIf(doublon Is Nothing, r, doublon), r)
  Else
    d(t) = t
  End If
Next
If Not doublon Is Nothing Then doublon.Cells(i, j).Interior.ColorIndex = 3

End Sub
(code que Job75 m'avait donné pour mon classeur)

Je l'ai adapté sur ton fichier, toutes les lignes qui ont la même valeur dans la cellule B sont de la même couleur, il faudrait voir pour changer la couleur à chaque fois que le contenu de la cellule est différent car là c'est un peu le souc... ;)
 

MaximeC

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

Ca ne marche pas .. et le but est de comparer deux colonnes, et de mettre les cellules de la colonne B identiques à la cellules de la colonne R de la même couleurs
 

Dranreb

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

If Cells(k, 18).Value = Cells(i, 2).Value & Cells(i, 2).Value <> "" & Cells(k, 18).Value <> "" Then 'Recherche
Il semble y avoir là dedans une grosse confusion entre l'opérateur "&" de concaténation et l'opérateur Boolean "And"
 

leop93

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

Hum, comparer deux colonnes entières ?! Tu es sûr que ce n'est pas cellule par cellule des colonnes ?

Car comparer une colonne entière, tu auras toujours des différences. D'ailleurs dans ton fichier texte, tu n'as rien dans la conne R, donc ce n'est pas viable...

Ce que je t'ai fait c'est:

- comparer ce qu'il y a dans les cellules B
- si 2 cellules B contiennent la même chose la ligne se colore (il manque la gestion des couleurs pour chaque valeur différente)

Toi tu veux faire quoi au final sur ton fichier test (que tu adapteras par la suite sur ton fichier pour ton boulot) ?
 

MaximeC

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

Finalement j'ai réussi à fair ce que je voulais, même si c'est un peu lours comme écriture, ce qui n'empéche pas le programme d'aller vite.. Je dois effectivement avoir un problème avec oui ... Par contre il me reste a trouver le moyen de modifier les couleurs ..

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

' 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 7433 ' Parcours des données recensées
If Cells(i, 2).Value = Cells(k, 18).Value Then

Cells(k, 18).Interior.ColorIndex = 5
Cells(i, 1).Interior.ColorIndex = 5
Cells(i, 2).Interior.ColorIndex = 5 'Recherche des similitudes en évitant les cellules non vides ..
Cells(i, 3).Interior.ColorIndex = 5
Cells(i, 4).Interior.ColorIndex = 5
Cells(i, 5).Interior.ColorIndex = 5
Cells(i, 6).Interior.ColorIndex = 5
Cells(i, 7).Interior.ColorIndex = 5
Cells(i, 8).Interior.ColorIndex = 5
Cells(i, 9).Interior.ColorIndex = 5
Cells(i, 10).Interior.ColorIndex = 5
Cells(i, 11).Interior.ColorIndex = 5
Cells(i, 12).Interior.ColorIndex = 5
Cells(i, 13).Interior.ColorIndex = 5
Cells(i, 14).Interior.ColorIndex = 5
Cells(i, 15).Interior.ColorIndex = 5
Cells(i, 16).Interior.ColorIndex = 5
End If
Next i

Next k

End Sub
 

Dranreb

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

J'avoue aussi être bien perplexe.
J'ai toujours sous le coude le Test_comparaison.xls avec 8 colonnes en feuil1, rarement mais diversement renseignées, une feuil2 avec juste 52 codes renseignés en colonne A, et je n'ai toujours pas compris ce qu'on voulait tirer de tout ça.
 

MaximeC

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

Ca marche en utilisant le And!!!
Merci beaucoup !!! :D

Maintenant lorsque j'utilise cette instruction dans la boucle if , cela ne fonctionne pas ... est ce normal??
m = 1
Cells(k, 18).Interior.ColorIndex = m
m = m + 1
 

leop93

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

Je suis d'accord avec toi Dranreb.

Maxime, on dirait que tu ne te préocupes pas trop de nos conseils... Et tu n'essayes pas de nous expliquer clairement ton problème alros que nous sommes deux, Franc-Comtois en plus ;) , à vouloir t'aider.

Sinon dans le code que tu viens d'envoyer, remplace ton For i = 3 To 7433 par For i = 3 To Cells(500, 18).End(xlUp).Row si c'est viable... Tu gagneras en temps d'éxécution amha.
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas