Macro recherches combinaisons cellules identiques

laurentdu38 · 12 Août 2013

Bonjour à tous,

Je suis nouveau le forum... et j'aurais besoin de petit coup de pouce pour m’aiguiller sur le code d'une macro.

J'ai 2 fichiers Excel, qui contient chacun 1 feuille de même nom.

Dans le fichier 1:

J'ai 3 colonnes avec des valeurs (ce sont des lettres)

Dans le fichier 2:

J'ai 15 colonnes.

J'aimerai retrouver toutes les combinaisons des colonnes A C E du fichier 2 non présentes dans le fichier 1. Idéalement que les lignes des combinaisons de colonnes non présentes passent en rouge.

Auriez vous un bout de code pour faire ça ? J'ai trouvé des bouts de code sur le forum mais c'est plus pour de la comparaison ligne à ligne de 2 feuilles.

Merci de votre aide
Laurent

mapomme · 12 Août 2013

Re : Macro recherches combinaisons cellules identiques

Bonsoir laurentdu38 et bienvenu 🙂 ,

il aurait été sympa. de joindre deux fichiers de test 🙄

Un essai avec des fichiers de mon cru. La macro est dans le fichier Classeur15col.xlsm. Il faut cliquer sur le bouton de la feuille "Feuil1". J'ai pris comme hypothèse que les deux fichiers sont ouverts dans Excel.

Le code dans le module1 du fichier Classeur15col.xlsm:

VB:

Sub Chercher_15_dans_3()
Dim sh15 As Worksheet, sh3 As Worksheet
Dim tablo3, tablo15, i As Long, j As Long

Application.ScreenUpdating = False
Set sh15 = Workbooks("Classeur15col.xlsm").Sheets("feuil1")
Set sh3 = Workbooks("Classeur3col.xlsx").Sheets("feuil1")

tablo3 = sh3.Range("a1").CurrentRegion.Value
tablo15 = sh15.Range("a1").CurrentRegion.Columns("a:e")

For i = 2 To UBound(tablo15)
  For j = 2 To UBound(tablo3)
    If (tablo15(i, 1) = tablo3(j, 1)) And _
        (tablo15(i, 3) = tablo3(j, 2)) And _
        (tablo15(i, 5) = tablo3(j, 3)) Then Exit For
  Next j
  If j <= UBound(tablo3) Then
    sh15.Range("A" & i & ":O" & i).Interior.Color = xlNone
  Else
    sh15.Range("A" & i & ":O" & i).Interior.Color = RGB(255, 0, 0)
  End If
Next i
Application.ScreenUpdating = True
Application.Goto sh15.Range("a1"), True

End Sub

nb: je n'ai pas optimisé la méthode. On pourrait faire plus rapide...

Edit: fichiers modifiés (voir message suivant)

mapomme · 12 Août 2013

Re : Macro recherches combinaisons cellules identiques

re-bonsoir laurentdu38,

J'ai mal lu la question et j'ai coloré les lignes de Classeur15col présentes dans Classeur3col. Alors qu'en fait il fallait faire le contraire.
La correction a été faite dans le message précédent.

mapomme · 12 Août 2013

Re : Macro recherches combinaisons cellules identiques

re-bonsoir laurentdu38,

Une autre méthode plus rapide. Il faut cocher la référence à Microsoft Scripting Runtime dans VBA.
Pour cela, dans l'éditeur VBA, utiliser le menu Outils / Références...

Le code:

VB:

Sub Chercher_15_dans_3_bis()
Dim sh15 As Worksheet, sh3 As Worksheet
Dim tablo3, tablo15, i As Long, T0 As Single
Dim Dico As New Scripting.Dictionary

T0 = Timer
Application.ScreenUpdating = False
Set sh15 = Workbooks("Classeur15col.xlsm").Sheets("feuil1")
Set sh3 = Workbooks("Classeur3col.xlsx").Sheets("feuil1")

tablo3 = sh3.Range("a1").CurrentRegion.Value
tablo15 = sh15.Range("a1").CurrentRegion.Columns("a:e")

For i = 2 To UBound(tablo3)
  Dico(tablo3(i, 1) & tablo3(i, 2) & tablo3(i, 3)) = ""
Next i

For i = 2 To UBound(tablo15)
  If Dico.Exists(tablo15(i, 1) & tablo15(i, 3) & tablo15(i, 5)) Then
    sh15.Range("A" & i & ":O" & i).Interior.Color = xlNone
  Else
    sh15.Range("A" & i & ":O" & i).Interior.Color = RGB(255, 0, 0)
  End If
Next i
Application.ScreenUpdating = True
Application.Goto sh15.Range("a1"), True
MsgBox Format(Timer - T0, "0.000 s")
End Sub

laurentdu38 · 13 Août 2013

Re : Macro recherches combinaisons cellules identiques

Salut mapomme,

Merci pour la marco c'est le top. C'est une super base pour ce que je souhaite faire.

J'aurai surement d'autres questions par la suite.

Merci encore 😉

laurentdu38 · 13 Août 2013

Re : Macro recherches combinaisons cellules identiques

Bon j'ai bossé un peu sur ma macro.

Y-a eu quelques évolutions, j'ai donc toujours 2 fichiers, un fichier nommé "d" et un fichier nommé "p".

Je souhaite toujours mettre en rouge les lignes du fichier "d" où l'on ne retrouve pas les combinaisons des cellules du fichier "p". Pour la colonne Localisation du fichier "d" elle peut valoir cellule "tpye1 2 3 4 5".

J'ai espacé mes colonnes dans les 2 fichiers. J'ai ajusté la macro comme je le pensais, mais j'ai une erreur d'incompatibilité de type. Je pense que ca vient du fait que mes colonnes ne sont pas contigues.

Cette fois ci je met mes fichiers en pièce jointe 🙂

Merci
Laurent 🙂

laurentdu38 · 13 Août 2013

Re : Macro recherches combinaisons cellules identiques

Bon ça à l'air bon en faisant ainsi, j'ai quand même un gros doute sur les lignes 11 et 12...

VB:

Sub verif()
Dim sh15 As Worksheet, sh3 As Worksheet
Dim TabD, TabP, i, j As Long, T0 As Single
Dim Dico As New Scripting.Dictionary

T0 = Timer
Application.ScreenUpdating = False
Set sh15 = Workbooks("p.xlsm").Sheets("feuil1")
Set sh3 = Workbooks("d.xlsm").Sheets("feuil1")

TabD = sh3.Range("d1").CurrentRegion.Columns("a:g")
TabP = sh15.Range("a1").CurrentRegion.Columns("a:u")

''' Type1 to type 5'''
For j = 5 To 21 Step 4

    '''Create platyne first Tab'''
    For i = 2 To UBound(TabP)
        Dico(TabP(i, 1) & TabP(i, 3) & TabP(i, j)) = ""
    Next i
    
    '''Check if combination EGF.SEF.Loca from DOSTEX is present to SNR'''
     
    For i = 2 To UBound(TabD)
      If Dico.Exists(TabD(i, 1) & TabD(i, 2) & TabD(i, 4)) Then
        sh3.Range("D" & i & ":G" & i).Interior.Color = xlNone
      Else
        sh3.Range("D" & i & ":G" & i).Interior.Color = RGB(255, 128, 128)
      End If
    Next i

Next j


Application.ScreenUpdating = True
Application.Goto sh15.Range("a1"), True
MsgBox Format(Timer - T0, "0.000 s")
End Sub

mapomme · 13 Août 2013

Re : Macro recherches combinaisons cellules identiques

Bonsoir laurentdu38,

Quatre petites choses:

1) J'ai redéfini les tableaux TabP et TabD car la propriété "CurrentRegion" ne prend pas en compte les données après une ligne vide ou colonne vide et vous avez effectivement des colonnes vides dans vos blocs de données (ligne 11 et 12).

2) J'ai modifié l'imbrication des boucles pour ne construire qu'une seule fois la table de référence (Dico) des triplets issus de TabP.
Le nombre de passage dans une boucle est donc :
5 * ( UBound(TabP)-2+1 ) (construction de dico) + ( UBound(TabD)-2+1) (boucle coloriage)
soit 5 * ( UBound(TabP)-1 ) + ( UBound(TabD)-1)

Pour votre code, le nombre de passage dans une boucle est :
5 *[ ( UBound(TabP)-2+1 ) + ( UBound(TabD)-2+1) ]
soit 5 * ( UBound(TabP)-1 ) + 5 * ( UBound(TabD)-1) qui est toujours supérieur à la première valeur.

3) Lorsqu'on concatène des données à fin de comparaison, il vaut mieux séparer les termes par un caractère improbable. En effet la concaténation des termes "A" et "BC" donne "ABC" comme le résultat de la concaténation de "AB" et "C". Avec le caractère de séparation "]" par exemple, on obtient "A]BC" et "AB]C". On évite ainsi certaines erreurs de comparaison.

4) S'il ne faut pas tenir compte des majuscules ou minuscules, on peut tout passer en minuscule dans le code:
Lcase( Dico(TabP(i, 1) & "]" & TabP(i, 3) & "]" & TabP(i, j)) )
et
Lcase( TabD(i, 1) & "]" & TabD(i, 2) & "]" & TabD(i, 4) )

Le code proposé:

VB:

Sub verif()
Dim sh15 As Worksheet, sh3 As Worksheet
Dim TabD, TabP, i As Long, j As Long, N As Long, T0 As Single
Dim Dico As New Scripting.Dictionary

T0 = Timer
Application.ScreenUpdating = False

Set sh3 = Workbooks("d.xlsm").Sheets("feuil1")
Set sh15 = Workbooks("p.xlsm").Sheets("feuil1")

'lecture des valeurs des deux tableaux
TabD = sh3.Range("D1:G" & sh3.Range("D" & Rows.Count).End(xlUp).Row)
TabP = sh15.Range("A1:U" & sh15.Range("A" & Rows.Count).End(xlUp).Row)

'Construction du DICO de référence (valeurs du fichier p.xlsm)
'5 triplets par ligne du fichier p.xlsm
N = UBound(TabP)
For i = 2 To N
  For j = 5 To 21 Step 4
    Dico(TabP(i, 1) & "]" & TabP(i, 3) & "]" & TabP(i, j)) = ""
  Next j
Next i

'Boucle de coloriage
N = UBound(TabD)
For i = 2 To UBound(TabD)
  If Dico.Exists(TabD(i, 1) & "]" & TabD(i, 2) & "]" & TabD(i, 4)) Then
    sh3.Range("D" & i & ":G" & i).Interior.Color = xlNone
  Else
    sh3.Range("D" & i & ":G" & i).Interior.Color = RGB(255, 128, 128)
  End If
Next i

Application.ScreenUpdating = True
Application.Goto sh15.Range("a1"), True
MsgBox Format(Timer - T0, "0.000 s")
End Sub

laurentdu38 · 14 Août 2013

Re : Macro recherches combinaisons cellules identiques

Bonjour mapomme,

Merci pour tes explications détaillées. Merci aussi pour la macro. Je vais regarder tout cela...

Bonne journée

Merci
Laurent

Macro recherches combinaisons cellules identiques

laurentdu38

Guest

mapomme

XLDnaute Barbatruc

Pièces jointes

mapomme

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

Pièces jointes

laurentdu38

Guest

laurentdu38

Guest

Pièces jointes

laurentdu38

Guest

mapomme

XLDnaute Barbatruc

Pièces jointes

laurentdu38

Guest

Discussions similaires

Macro recherches combinaisons cellules identiques

laurentdu38

Guest

mapomme

XLDnaute Barbatruc

Pièces jointes

mapomme

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

Pièces jointes

laurentdu38

Guest

laurentdu38

Guest

Pièces jointes

laurentdu38

Guest

mapomme

XLDnaute Barbatruc

Pièces jointes

laurentdu38

Guest

Discussions similaires

Privacy & Transparency

Privacy & Transparency