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

 

[leop93]

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

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

Leop93

 

[Dranreb]

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]

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

 

[Dranreb]

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]

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.

Sub taFonction()

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

'TON CODE

Next

End sub

 

[MaximeC]

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

 

[MaximeC]

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

(xlUp).Row??

 

[Dranreb]

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

Non :

If Cells(k, 18).Value "" Then Exit For '

Mais la solution style leop93 est bien aussi.:

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

 

[MaximeC]

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]

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]

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:

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]

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]

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"