Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Comparer deux tableau sur une même feuille

  • Initiateur de la discussion Initiateur de la discussion laurent950
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

laurent950

XLDnaute Barbatruc
Bonsoir,

Je cherche a comparer deux tableau sur une même feuille, soit dans le Tableau A des choses qu'il manque dans le Tableau B (Je voudrais un Faux en face des données manquantes)

J'ai fait une boucle (et la boucle tourne en boucle, elle remplie tous par faux)
j'ai joint un exemple (sur fichier excel)

Ps : j'ai les deux version 2003 ou 2007

si quelqu'un a la solution je vous remerci

laurent
 

Pièces jointes

Re : Comparer deux tableau sur une même feuille

Voilou 🙂 (avec remplissage auto. de la partie jaune)

Code:
Sub test()
Z = 6
' c = Tableau B
For Each c In Range(Cells(5, 6), Cells(65536, 6).End(xlUp))
' k = Tableau A
    For Each k In Range(Cells(5, 1), Cells(65536, 1).End(xlUp))
        trouv = 0
        If k = c Then
            trouv = 1
            Exit For
        End If

    Next k
    If trouv = 0 Then
        Range(c.Address).Offset(, 3) = "FAUX"
        ' remplissage automatique de la partie jaune
        Cells(Z, 12) = Range(c.Address)
        Cells(Z, 13) = Range(c.Address).Offset(, 1)
        Cells(Z, 14) = Range(c.Address).Offset(, 2)
        Z = Z + 1
    End If
Next c
End Sub
 
Dernière modification par un modérateur:
Re : Comparer deux tableau sur une même feuille

J'ai travailler et j'ai trouver cette solution :

Sub ColorieCommunsOK()

' Tableau B = TabB (Le tableau le plus complet = toutes les valeurs)
Set TabB = Range(Cells(5, 6), Cells(65536, 6).End(xlUp))
Set MonDico1 = CreateObject("Scripting.Dictionary")

' Tableau A = TabA (Celuis avec les valeurs manquantes)
Set TabA = Range(Cells(5, 1), Cells(65536, 1).End(xlUp))
Set MonDico2 = CreateObject("Scripting.Dictionary")

' Remplissage Valeur du tableau A mise en mémoire
For Each c In TabA
MonDico2(c.Value) = c.Value
Next c

' Remplissage Valeur du tableau B (celuis avec toutes les valeurs)
For Each c In TabB
MonDico1(c.Value) = c.Value

' Condition suite au remplissage (si dans MonDico2 la valeur existe = Faux)
If MonDico2.exists(c.Value) Then
Range(c.Address).Offset(, 3) = "FAUX"
Else
End If
Next c
End Sub


PS : comment inverser cette macro si FAUX = la case est Vide et si la case est Vide mettre FAUX

Une personne a une idées s'il vous plais ?

Laurent
 
[Resolu] Comparer deux tableau sur une même feuille

Merci à toi unrender,

je vais tester votre macro j'ai finis la mienne c'était pas trés simple.

Sub ColorieCommunsinverse()

' Tableau B = TabB (Le tableau le plus complet = toutes les valeurs)
Set TabB = Range(Cells(5, 6), Cells(65536, 6).End(xlUp))
Set MonDico1 = CreateObject("Scripting.Dictionary")

' Tableau A = TabA (Celuis avec les valeurs manquantes)
Set TabA = Range(Cells(5, 1), Cells(65536, 1).End(xlUp))
Set MonDico2 = CreateObject("Scripting.Dictionary")

' Nettoyage
TabB.Offset(, 3).Clear

' Remplissage Valeur du tableau A mise en mémoire
For Each c In TabA
MonDico2(c.Value) = c.Value
Next c

' Remplissage Valeur du tableau B (celuis avec toutes les valeurs)
For Each c In TabB
MonDico1(c.Value) = c.Value

' Condition suite au remplissage (si dans MonDico2 la valeur existe = Faux)
If Not MonDico2.Exists(c.Value) Then
Range(c.Address).Offset(, 3) = "FAUX"
Else
End If
Next c
End Sub

je joint le fichier

laurent
 

Pièces jointes

Re : Comparer deux tableau sur une même feuille

Bonsoir,

moins sophistiqué et avec de la couleur :
Code:
Sub test()
    Dim C As Range, Est As Range
    For Each C In Range(Cells(5, 6), Cells(65536, 6).End(xlUp))
        Set Est = Range(Cells(5, 1), Cells(65536, 1).End(xlUp)).Find(C, LookIn:=xlValues)
        If Est Is Nothing Then
            C.Offset(, 3) = "FAUX"
        Else
            C.Interior.ColorIndex = 4
        End If
    Next
End Sub
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…