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

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

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

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

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
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

  • Résolu(e)
XL 2016 VBA - Calcul des hauteur et largeur des Headings (pour les forts en thème)
2
Réponses
23
Affichages
484
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
359
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
223
job75
O
  • Question
XL 2013 Recopier automatique des valeurs d'un onglet vers un autre onglet selon critère
Réponses
2
Affichages
443
olivieroma
O
P
  • Résolu(e)
XL 2021 Besoin d'aide pour copier/coller données de plusieurs classeurs
2
Réponses
20
Affichages
606
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
288
jerome91
J
C
  • Résolu(e)
Microsoft 365 Problème VBA lors de l'affichage de ligne masquée
2
Réponses
21
Affichages
618
Chris Linefield
C
C
  • Question
XL 2021 Problème de remplissage d'une colonne conditionné à d'autres valeurs
Réponses
2
Affichages
332
CathyLD
C
S
  • Question
Microsoft 365 VBA pour copier une une des données d'une ligne à une autre
Réponses
3
Affichages
580
salma_hayek
S
  • Résolu(e)
Microsoft 365 Vba : Transférer des données d'un tableau dans un autre fichier
Réponses
7
Affichages
367
Chaton77
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…