XL 2016 vérifier entre deux fichiers que les valeurs d'une colonne correspondent en vba

E

Excellerateur

XLDnaute Occasionnel
Bonjour chers membres,

Dans le fichier joint ci dessous, j'ai deux onglets sources (onglet "Bill" et onglet "Gates"). dans chacune de ces feuilles, la colonne "D" ou colonne "CodE I" est ce qui les rassemble l'un de l'autre (on retrouve les mêmes valeurs dans les deux tableaux).

Mon souci est que je cherche à Vérifier (par code vba) que toutes les valeurs de la colonne "D" ou colonne "codE I" de "Bill" sont dans l'onglet "Gates" et inversement.

Et puis si tel n'est pas le cas faire apparaitre sur un onglet les lignes qui ont des CodE I isolés. (dans ce fichier j'ai introduit pour l'exemple quelques lignes avec codE I qui ne sont pas référencés dans l'autre fichier et inversement).

Vous remerciant en avance pour votre aide.
 

Pièces jointes

  • Prime test (2).xlsm
    868.1 KB · Affichages: 7
Solution
sylvanu
Le code :
VB: 
Public Tbill, Tgates: Option Base 1
Sub ListeAbsent()
    Dim i%, j%, k%, Ligne%, n%
    Dim T(): ReDim Preserve T(12, 1): n = 1
    Sheets("Absents").[A:L].ClearContents
    Sheets("Absents").Range("A1:L1") = Sheets("Bill").Range("A1:L1").Value ' Copier Coller entete
    Sheets("Absents").Range("L1") = "Absent dans"
    Application.ScreenUpdating = False
    ' Transfert des deux tableaux dans Absents
    DL1 = Sheets("Bill").[A65000].End(xlUp).Row
    Tbill = Sheets("Bill").Range("A2:L" & DL1).Value
    DL2 = Sheets("Gates").[A65000].End(xlUp).Row
    Tgates = Sheets("Gates").Range("A1:L" & DL2).Value
    Ligne = 2
    ' Absent dans Gates
    For i = 1 To UBound(Tbill)
        If Present(Tgates, Tbill(i, 4)) = 0 Then    ' si 0 alors...
Trier par date Trier par votes
Robert

Robert

XLDnaute Barbatruc
Repose en paix
Bonjour Excellerateur, bonjour le forum,

Le code ci-dessous colore en rouge les cellules de l'onglet Bill qui ne se trouvent pas dans l'onglet Gates et en vert les cellule de l'onglet Gates qui ne se trouvent pas dans l'onglet Bill :
VB: 
Sub Macro1()
Dim OB As Worksheet 'déclare la variable OB (Onglet Bill)
Dim OG As Worksheet 'déclare la variable OG (Onglet Gates)
Dim TB As Variant 'déclare la variable TB (Tableau Bill)
Dim TG As Variant 'déclare la variable TG (Tableau Gates)
Dim I As Integer 'déclare la variable I (Incr;ement)
Dim J As Integer 'déclare la variable J (incrément)
Dim TEST As Boolean 'déclare la variable TEST
Dim R As Range 'déclare la variable R (Techerche)

Set OB = Worksheets("Bill") 'définit l'onglet OB
Set OG = Worksheets("Gates") 'définit l'onglet OG
TB = OB.Range("A1").CurrentRegion 'définit le tableau TB
TG = OG.Range("A1").CurrentRegion 'définit le tableau TG
For I = 2 To UBound(TB, 1) 'boucle sur toutes les lignes I de TB (en partant de la seconde)
    'définit la recherche R (recherche la valeur exacte de la donnée ligne I colonne 4 de TB dans la colonne 4 de TG)
    Set R = OG.Columns(4).Find(TB(I, 4), , xlValues, xlWhole)
    If R Is Nothing Then OB.Cells(I, 4).Interior.ColorIndex = 3 'si aucune occurrence n'est trouvée, colore la cellule ligne I colonne 4 de TB en rouge
Next I 'prochaine ligne de la boucle
For I = 1 To UBound(TG, 1) 'boucle sur toutes les lignes I de TG
    'définit la recherche R (recherche la valeur exacte de la donnée ligne I colonne 4 de TG dans la colonne 4 de TB)
    Set R = OB.Columns(4).Find(TG(I, 4), , xlValues, xlWhole)
    If R Is Nothing Then OG.Cells(I, 4).Interior.ColorIndex = 4 'si aucune occurrence n'est trouvée, colore la cellule ligne I colonne 4 de TB en vert
Next I 'prochaine ligne de la boucle
End Sub
 
Vote positif 0 Vote négatif
E

Excellerateur

XLDnaute Occasionnel
Robert à dit:
Bonjour Excellerateur, bonjour le forum,

Le code ci-dessous colore en rouge les cellules de l'onglet Bill qui ne se trouvent pas dans l'onglet Gates et en vert les cellule de l'onglet Gates qui ne se trouvent pas dans l'onglet Bill :
VB: 
Sub Macro1()
Dim OB As Worksheet 'déclare la variable OB (Onglet Bill)
Dim OG As Worksheet 'déclare la variable OG (Onglet Gates)
Dim TB As Variant 'déclare la variable TB (Tableau Bill)
Dim TG As Variant 'déclare la variable TG (Tableau Gates)
Dim I As Integer 'déclare la variable I (Incr;ement)
Dim J As Integer 'déclare la variable J (incrément)
Dim TEST As Boolean 'déclare la variable TEST
Dim R As Range 'déclare la variable R (Techerche)

Set OB = Worksheets("Bill") 'définit l'onglet OB
Set OG = Worksheets("Gates") 'définit l'onglet OG
TB = OB.Range("A1").CurrentRegion 'définit le tableau TB
TG = OG.Range("A1").CurrentRegion 'définit le tableau TG
For I = 2 To UBound(TB, 1) 'boucle sur toutes les lignes I de TB (en partant de la seconde)
    'définit la recherche R (recherche la valeur exacte de la donnée ligne I colonne 4 de TB dans la colonne 4 de TG)
    Set R = OG.Columns(4).Find(TB(I, 4), , xlValues, xlWhole)
    If R Is Nothing Then OB.Cells(I, 4).Interior.ColorIndex = 3 'si aucune occurrence n'est trouvée, colore la cellule ligne I colonne 4 de TB en rouge
Next I 'prochaine ligne de la boucle
For I = 1 To UBound(TG, 1) 'boucle sur toutes les lignes I de TG
    'définit la recherche R (recherche la valeur exacte de la donnée ligne I colonne 4 de TG dans la colonne 4 de TB)
    Set R = OB.Columns(4).Find(TG(I, 4), , xlValues, xlWhole)
    If R Is Nothing Then OG.Cells(I, 4).Interior.ColorIndex = 4 'si aucune occurrence n'est trouvée, colore la cellule ligne I colonne 4 de TB en vert
Next I 'prochaine ligne de la boucle
End Sub
Cliquez pour agrandir...
Bonjour @Robert , salut cher fil,

T'es un vrai boss @Robert car ta formule marche très bien, merci infiniment.
En fait je voudrais adapter ton code pour ressortir les lignes avec les valeurs en vert et rouge dans un autre tableau, mais je n'y arrive pas.

je remercie d'avance tout contributeur.
 
Vote positif 0 Vote négatif
Robert

Robert

XLDnaute Barbatruc
Repose en paix
Bonjour le fil, bonjour le forum,

Essaie comme ça :
VB: 
Sub Macro1()
Dim OB As Worksheet 'déclare la variable OB (Onglet Bill)
Dim OG As Worksheet 'déclare la variable OG (Onglet Gates)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TB As Variant 'déclare la variable TB (Tableau Bill)
Dim TG As Variant 'déclare la variable TG (Tableau Gates)
Dim I As Integer 'déclare la variable I (Incr;ement)
Dim J As Integer 'déclare la variable J (incrément)
Dim TEST As Boolean 'déclare la variable TEST
Dim R As Range 'déclare la variable R (Techerche)
Dim DEST As Range 'déclare la varaible DEST (cellule de DESTination)

Set OB = Worksheets("Bill") 'définit l'onglet OB
Set OG = Worksheets("Gates") 'définit l'onglet OG
On Error Resume Next 'gestion des errurs (en cas d'erreur passe à la ligne suivante)
Set OD = Worksheets("Résultat") 'définit l'onglet OD (génère une erreur si cet onglet n'existe pas
If Err > 0 Then 'condition : si une erreur a été générée
    Err.Clear 'supprime l'erreur
    Worksheets.Add After:=Sheets(Sheets.Count) 'ajoute un onglet en dernière position
    ActiveSheet.Name = "Résultat" 'renomme l'onglet
    Set OD = ActiveSheet 'définit l'onglet OD
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
OD.Cells.Clear 'efface les éventuelles anciennes données
TB = OB.Range("A1").CurrentRegion 'définit le tableau TB
TG = OG.Range("A1").CurrentRegion 'définit le tableau TG
For I = 2 To UBound(TB, 1) 'boucle sur toutes les lignes I de TB (en partant de la seconde)
    'définit la recherche R (recherche la valeur exacte de la donnée ligne I colonne 4 de TB dans la colonne 4 de TG)
    Set R = OG.Columns(4).Find(TB(I, 4), , xlValues, xlWhole)
    If R Is Nothing Then 'condition : si aucune occurrence n'est trouvée
        'définit la cellule de destination DEST (A1 si A1 est vide, sinon, la première cellule vide de la colonne A de l'onglet OD)
        If OD.Range("A1").Value = "" Then Set DEST = OD.Range("A1") Else Set DEST = OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0)
        OB.Rows(I).Copy DEST 'copie la ligne I  de l'onglet OB et la colle dans DEST
        OD.Rows(DEST.Row).Interior.ColorIndex = 3 'colore la cellule ligne de DEST en rouge
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle
For I = 1 To UBound(TG, 1) 'boucle sur toutes les lignes I de TG
    'définit la recherche R (recherche la valeur exacte de la donnée ligne I colonne 4 de TG dans la colonne 4 de TB)
    Set R = OB.Columns(4).Find(TG(I, 4), , xlValues, xlWhole)
    'définit la cellule de destination DEST (A1 si A1 est vide, sinon, la première cellule vide de la colonne A de l'onglet OD)
    If R Is Nothing Then 'condition : si aucune occurrence n'est trouvée
        'définit la cellule de destination DEST (A1 si A1 est veide, sinon, la première cellule vide de la colonne A de l'onglet OD)
        If OD.Range("A1").Value = "" Then Set DEST = OD.Range("A1") Else Set DEST = OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0)
        OG.Rows(I).Copy DEST 'copie la ligne I  de l'onglet OG et la colle dans DEST
        OD.Rows(DEST.Row).Interior.ColorIndex = 4 'colore la cellule ligne de DEST en vert
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle
End Sub

[Édition]
Heu non ! n'essaie pas... Prend plutôt le code de Sylvanu bien plus rapide....
 
Vote positif 0 Vote négatif
sylvanu

sylvanu

XLDnaute Barbatruc
Supporter XLD
Le code :
VB: 
Public Tbill, Tgates: Option Base 1
Sub ListeAbsent()
    Dim i%, j%, k%, Ligne%, n%
    Dim T(): ReDim Preserve T(12, 1): n = 1
    Sheets("Absents").[A:L].ClearContents
    Sheets("Absents").Range("A1:L1") = Sheets("Bill").Range("A1:L1").Value ' Copier Coller entete
    Sheets("Absents").Range("L1") = "Absent dans"
    Application.ScreenUpdating = False
    ' Transfert des deux tableaux dans Absents
    DL1 = Sheets("Bill").[A65000].End(xlUp).Row
    Tbill = Sheets("Bill").Range("A2:L" & DL1).Value
    DL2 = Sheets("Gates").[A65000].End(xlUp).Row
    Tgates = Sheets("Gates").Range("A1:L" & DL2).Value
    Ligne = 2
    ' Absent dans Gates
    For i = 1 To UBound(Tbill)
        If Present(Tgates, Tbill(i, 4)) = 0 Then    ' si 0 alors absent, donc transfert
            For k = 1 To 11
                T(k, n) = Tgates(i, k)
            Next k
            T(12, n) = "Gates"
            Ligne = Ligne + 1: n = n + 1
            ReDim Preserve T(12, n)
        End If
    Next i
    ' Absent dans Bill
    For i = 1 To UBound(Tgates)
        If Present(Tbill, Tgates(i, 4)) = 0 Then
            For k = 1 To 11
                T(k, n) = Tgates(i, k)
            Next k
            T(12, n) = "Bill"
            Ligne = Ligne + 1: n = n + 1
            ReDim Preserve T(12, n)
        End If
    Next i
    Sheets("Absents").[A2].Resize(UBound(T, 2), UBound(T, 1)) = WorksheetFunction.Transpose(T)
    Application.ScreenUpdating = True
End Sub
Function Present(Plage, Valeur)
' Present retourne 0 si absent et 1 si présent
    Present = 0
    For Ind = 1 To UBound(Plage)
        If Plage(Ind, 4) = Valeur Then
            Present = 1
            Exit Function
        End If
    Next Ind
End Function
et le fichier en xlsx auquel j'ai rajouté la feuille Absents avec le bouton de lancement.
 

Pièces jointes

  • Prime test (3).xlsx
    923.8 KB · Affichages: 1
Vote positif 0 Vote négatif
Solution

Discussions similaires

J
  • Question
Microsoft 365 extraction VBA avec formule si
Réponses
10
Affichages
330
Phil69970
Phil69970
G
  • Question
Microsoft 365 Transfert de données
Réponses
7
Affichages
328
GClaire
G
G
  • Question
Microsoft 365 Saut de ligne dans une cellule
Réponses
3
Affichages
126
GClaire
G
E
  • Question
Microsoft 365 rapprocher deux fichiers grâce à une correspondance entre colonnes
Réponses
7
Affichages
328
sylvanu
sylvanu
chris6999
  • Question
Microsoft 365 MACRO VBA - Extraire des listes à partir d'une boucle
Réponses
5
Affichages
193
chris6999
chris6999
Y
  • Question
probléme au niveau mon code vba
Réponses
3
Affichages
91
Dranreb
Dranreb
O
  • Question
Autres VBA test et action selon valeur de la première cellule visible en colonne A après un tri
Réponses
8
Affichages
445
Oko
O
A
  • Question
XL 2019 Filtre avancé en VBA
Réponses
12
Affichages
293
Amilo
A
M
  • Question
XL 2019 VBA Valeur d'une cellule dont la feuille et la ligne est dans la feuille courante
Réponses
13
Affichages
395
job75
job75
N
  • Question
XL 2019 VBA transposition de données sous condition
Réponses
5
Affichages
625
NLCF
N

Membres actuellement en ligne

14 membres et 95 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 115
Messages
2 085 451
Membres
102 889
dernier inscrit
monsef JABBOUR