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

Dudu2
  • Résolu(e)
XL 2016 VBA - Calcul des hauteur et largeur des Headings (pour les forts en thème)
2
Réponses
23
Affichages
571
Dudu2
Dudu2
N
  • Question
Microsoft 365 afficher/masquer des lignes en fonction de la valeur d'une cellule qui aura été renseignée par une autre feuille (via un copier/collé automatique)
Réponses
5
Affichages
451
Nel'
N
C
  • Question
Mettre une cellule en jaune quand le contenue correspond a une des valeurs d'une colonne d'un autre onglet
Réponses
9
Affichages
288
job75
job75
O
  • Question
XL 2013 Recopier automatique des valeurs d'un onglet vers un autre onglet selon critère
Réponses
2
Affichages
469
olivieroma
O
P
  • Résolu(e)
XL 2021 Besoin d'aide pour copier/coller données de plusieurs classeurs
2
Réponses
20
Affichages
684
Pac41240
P
J
  • Question
XL 2021 Macro : avoir les mois en chiffres de 1 à 12 en colonne à chaque ligne différente
Réponses
5
Affichages
314
jerome91
J
C
  • Résolu(e)
Microsoft 365 Problème VBA lors de l'affichage de ligne masquée
2
Réponses
21
Affichages
663
Chris Linefield
C
C
  • Question
XL 2021 Problème de remplissage d'une colonne conditionné à d'autres valeurs
Réponses
2
Affichages
374
CathyLD
C
S
  • Question
Microsoft 365 VBA pour copier une une des données d'une ligne à une autre
Réponses
3
Affichages
611
salma_hayek
S
Chaton77
  • Résolu(e)
Microsoft 365 Vba : Transférer des données d'un tableau dans un autre fichier
Réponses
7
Affichages
405
Chaton77
Chaton77

Membres actuellement en ligne

10 membres et 106 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
315 138
Messages
2 116 676
Membres
112 832
dernier inscrit
AlexLFG