Compare colonne de deux classeurs.xls et rempli une cellule .. Résolu/Fermé

Question

BONSOIR,
 Vérifie colonne (A3 :A500 de feuil1 du classeur DISPO.xls) avec la colonne (A3 :A500  de la feuille NOUVADH du classeur RECEPTION_DISPO.xls).
Les deux  classeurs sont dans le dossier ( C:\Users\michel\Desktop\A_COMMENTcaMARCHE)
 Quand il y a correspondance  met un P dans la colonne P de la feuille NOUVADH
 du classeur RECEPTION_DISPO.xls
 Mais s'il n'a pas correspondance dans RECEPTION_DISPO.xls mettre un message 
Model ci-joint   https://www.cjoint.com/?DHhwilwrYA5 
Je nage complètement MERCI de votre aide
micheleliane

pijaku · Answer

Bonjour,

Les deux classeurs sont ils ouverts au moment du lancement de la macro?
La macro devra être dans le classeur  RECEPTION_DISPO.xls?

micheleliane · Answer

BONJOUR,pijaku

La macro dans le classeur RECEPTION_DISPO.xls cela est parfait
et  le classeur DISPO.xls est fermé.

MERCI

micheleliane · Answer

re BONJOUR,pijaku 

Je crois que 5000 lignes seras largement suffisant 

MERCI

micheleliane

pijaku · Answer

Bon.
Voici le code à insérer dans un module du classeur RECEPTION_DISPO.xls

Sub Compare_Col_A_DISPO()
Dim monWbk As Workbook
Dim Chemin As String, Fichier As String
Dim dl As Long, Lig As Long, Num As Long
Dim Tb_Dispo(), Tb_Recep_Dispo(), Tb_Col_P()

Set monWbk = ThisWorkbook
Chemin = monWbk.Path & ""
Fichier = "DISPO.xls"

'***** TRAITEMENT SUR CLASSEUR DISPO.xls ****
Workbooks.Open Chemin & Fichier 'ouverture
With ActiveWorkbook
    With .Worksheets("Feuil1")
        dl = .Range("A" & Rows.Count).End(xlUp).Row
        Tb_Dispo = .Range("A3:A" & dl).Value 'stockage des données
    End With
    .Close False 'fermeture
End With

'***** TRAITEMENT SUR CLASSEUR RECEPTION_DISPO.xls ****
With monWbk.Sheets("NOUVADH")
    dl = .Range("A" & Rows.Count).End(xlUp).Row
    Tb_Recep_Dispo = .Range("A3:A" & dl).Value 'stockage des données
    ReDim Preserve Tb_Col_P(UBound(Tb_Recep_Dispo))
    'boucle sur les données de RECEPTION_DISPO
    For Lig = LBound(Tb_Recep_Dispo) To UBound(Tb_Recep_Dispo)
        Num = 0
        On Error Resume Next
        'Vérification de la présence dans DISPO.xls
        Num = Application.Match(Tb_Recep_Dispo(Lig, 1), Application.Index(Tb_Dispo, , 1), 0)
        On Error GoTo 0
        If Num = 0 Then
            'pas de correspondance
            Tb_Col_P(Lig) = "Pas de correspondance dans DISPO.xls"
        Else
            'correspondance
            Tb_Col_P(Lig) = "P"
        End If
    Next Lig
    
    '***** RESTITUTION DES "P" et "Pas de correspondance dans DISPO.xls" *****
    .Range("P2").Resize(UBound(Tb_Col_P) + 1) = Application.Transpose(Tb_Col_P)
    
End With
End Sub
 
 
Cordialement,
Franck

micheleliane · Answer

re BONJOUR,pijaku 
J'ai erreur le nom du classeur n'ai pas bonne et je ne comprend pas comment 
changer l'adresse ( C:\Users\michel\Desktop\A_COMMENTcaMARCHEDISPO.xls) 
dans la ligne (12) en JAUNE ci dessous la bonne adresse
( C:\Users\michel\Desktop\A_COMMENTcaMARCHE\DISPO.xls) 
Je m'excuse mais ne trouve pas
Pouvez vous expliquer ou se trouve l'adresse
MERCI
micheleliane

micheleliane · Answer

re re re BONJOUR,pijaku
Pour le chemin cela fonctionne 
Excuse moi je me suis encore mal exprimé pour (pas de correspondance )je voudrais
que le contenue de la cellule dans DISPO et qui ne trouve pas sa correspondance 
dans RECEPTION_DISPO 
Explication dans (NOUVADH de RECEPTION_DISPO)normalement tous les adhérents son inscrit
 Dans (DISPO) seulement ceux qui participe mais ils peut avoir des
nouveaux qui ne sont pas encore dans l'autre classeur 
En exemple le 3333 de( DISPO) n'existe pas dans(RECEPTION_DISPO) il faut le signaler
En espérant votre comprehension 
MERCI
micheleliane

micheleliane · Answer

re BONJOUR,pijaku 
Vous avez vue comment je suis nul, je voudrais qu'il faut valider qu'il n'y a pas
de correspondance pour l'ajouter dans (RECEPTION_DISPO)
Excusez-moi de ne pas savoir mieux expliquer
MERCI
micheleliane

micheleliane · Answer

re BONJOUR pijaku

La référence que vous indiquez est parfaite oui il faut l'ajouter

MERCI à l'avance
micheleliane

pijaku · Answer

RE-
Et voici :
Sub Compare_Col_A_DISPO()Dim monWbk As WorkbookDim Chemin As String, Fichier As StringDim dl As Long, Lig As Long, Num As LongDim Tb_Dispo(), Tb_Recep_Dispo(), Tb_Col_P()Set monWbk = ThisWorkbookChemin = monWbk.Path & ""Fichier = "DISPO.xls"'***** TRAITEMENT SUR CLASSEUR DISPO.xls ****Workbooks.Open Chemin & Fichier 'ouvertureWith ActiveWorkbook    With .Worksheets("Feuil1")        dl = .Range("A" & Rows.Count).End(xlUp).Row        Tb_Dispo = .Range("A3:A" & dl).Value 'stockage des données    End With    .Close False 'fermetureEnd With'***** TRAITEMENT SUR CLASSEUR RECEPTION_DISPO.xls ****With monWbk.Sheets("NOUVADH")    dl = .Range("A" & Rows.Count).End(xlUp).Row    Tb_Recep_Dispo = .Range("A3:A" & dl).Value 'stockage des données    ReDim Preserve Tb_Col_P(UBound(Tb_Recep_Dispo))    'boucle sur les données de RECEPTION_DISPO    For Lig = LBound(Tb_Recep_Dispo) To UBound(Tb_Recep_Dispo)        Num = 0        On Error Resume Next        'Vérification de la présence dans DISPO.xls        Num = Application.Match(Tb_Recep_Dispo(Lig, 1), Application.Index(Tb_Dispo, , 1), 0)        On Error GoTo 0        If Num = 0 Then            'pas de correspondance            Tb_Col_P(Lig) = ""        Else            'correspondance            Tb_Col_P(Lig) = "P"        End If    Next Lig        '***** RESTITUTION DES "P" et "Pas de correspondance dans DISPO.xls" *****    .Range("P2").Resize(UBound(Tb_Col_P) + 1) = Application.Transpose(Tb_Col_P)    '***** TRAITEMENT des références disponibles dans DISPO mais pas dans RECEPTION    For Lig = LBound(Tb_Dispo) To UBound(Tb_Dispo)        Num = 0        On Error Resume Next        'Vérification de la présence dans RECEPTION_DISPO.xls        Num = Application.Match(Tb_Dispo(Lig, 1), Application.Index(Tb_Recep_Dispo, , 1), 0)        On Error GoTo 0        If Num = 0 Then            'pas de correspondance            If MsgBox("La référence : " & Tb_Dispo(Lig, 1) & ", présente dans DISPO.xls, n'est pas enregistrée dans RECEPTION_DISPO.xls." & Chr(10) & "Voulez-vous l'ajouter?", vbYesNo + vbQuestion) = vbYes Then                .Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Tb_Dispo(Lig, 1)            End If        End If    Next LigEnd WithEnd Sub

micheleliane · Answer

BONNE SOIREE,pijaku 

MERCI cela fonctionne très bien
MERCI de votre patience
MERCI du temps que vous m'avez accordé

micheleliane

Compare colonne de deux classeurs.xls et rempli une cellule ..

10 réponses

Discussions similaires