Extraire différence entre deux fichiers excel Fermé

Question

Bonjour,

Voilà mon problème : j'ai deux fichiers excel très volumineux (environ 10 000 lignes chacun). J'aimerais extraire les lignes différentes entre les deux fichiers. Sachant que je ne suis pas très doué en excel, comment puis-je m'y prendre ?

Merci d'avance pour votre aide !!!!

Frenchie83 · Answer

Bonjour
Voici une proposition.
Cliquez sur le lien suivant, puis clic droit sur le lien proposé et sélectionnez "Enregistrer la cible du lien sous "
https://www.cjoint.com/c/FEwb4IYMIsw
Ouvrez le fichier, 
Cliquez sur le bouton "Comparer 2 classeurs"
Une fenêtre s'ouvre: sélectionnez votre premier fichier
La fenêtre s'ouvre à nouveau: sélectionnez le deuxième fichier
Patientez quelques secondes
Le contenu des 2 classeurs est recopié et les lignes en écart sont filtrées dans les colonnes A et B
Si chaque classeur comporte plusieurs colonnes à comparer, la recopie de toutes ces colonnes est concentrée dans la même cellule.
A tester
Cdlt

Frenchie83 · Answer

Bonjour
Avez-vous la réponse à mon problème ?  Peut-être! Pour cela il faudrait que je dispose d'un échantillon des 2 fichiers pour que je vois comment ils sont faits.
Déposez sur cjoint.com un extrait de vos 2 fichiers (sans données confidentielles) . Quelques lignes suffisent.
Pour déposer un fichier en pièce jointe
aller "www.cjoint.com"
-clic sur "parcourir"
-sélectionnez le fichier à envoyer
-clic sur "créer le lien Cjoint" (bouton en bas)
-clic droit sur le lien proposé, et sélectionnez "copier l'adresse du lien"
-sur votre nouvelle demande CCM, -clic droit coller
Répétez l'opération pour y déposer le 2ème fichier.
Cdlt

Frenchie83 · Answer

Voilà, remplacez le code précédent par celui-ci
Sub ExtractionDifférence()
    Application.ScreenUpdating = False
    Set f1 = ThisWorkbook
    
OuvrirFichier1:
    Fichier1 = Application.GetOpenFilename(filefilter:="tout,*.*", Title:="Sélection")
    If Fichier1 = False Then
        MsgBox "aucun fichier sélectionné", vbOKOnly + vbCritical, "fin de procédure "
        Exit Sub
    End If
    ThisWorkbook.FollowHyperlink Fichier1
    Fichier1 = ActiveWindow.Caption
    
OuvrirFichier2:
    Fichier2 = Application.GetOpenFilename(filefilter:="tout,*.*", Title:="Sélection")
    If Fichier2 = False Then
        MsgBox "aucun fichier sélectionné", vbOKOnly + vbCritical, "fin de procédure "
        Exit Sub
    End If
    If Fichier1 = Fichier2 Then
        MsgBox "Ce ficier est déjà ouvert"
        GoTo OuvrirFichier2
    End If
    ThisWorkbook.FollowHyperlink Fichier2
    Fichier2 = ActiveWindow.Caption
    
    f1.Activate
    Set F2 = Windows(Fichier1)
    Set F3 = Windows(Fichier2)
    ActiveSheet.AutoFilterMode = False
    Columns("A:C").ClearContents
    
    Set DicoF2 = CreateObject("Scripting.Dictionary")
    Set DicoF3 = CreateObject("Scripting.Dictionary")
    F2.Activate
    Sheets(1).Activate
    DerLigF2 = Sheets(1).Cells.Find("*", , , , xlByColumns, xlPrevious).Row
    DerColF2 = Sheets(1).Cells.Find("*", , , , xlByColumns, xlPrevious).Column
    For Each C In Range("A2:A" & DerLigF2)
        For i = 1 To DerColF2
            If Cells(C.Row, i) = "" Then ValCell = "£" Else ValCell = Cells(C.Row, i) & "£"
            X = X & ValCell
        Next i
        DebC = C
        C = X
        DicoF2.Add C, ""
        C = DebC
        X = ""
    Next C
Cdlt
    f1.Activate
    [A2].Resize(DicoF2.Count) = Application.Transpose(DicoF2.keys)

F3.Activate
    Sheets(1).Activate
    DerLigF3 = Sheets(1).Cells.Find("*", , , , xlByColumns, xlPrevious).Row
    DerColF3 = Sheets(1).Cells.Find("*", , , , xlByColumns, xlPrevious).Column
    For Each C In Range("A2:A" & DerLigF3)
        For i = 1 To DerColF3
            If Cells(C.Row, i) = "" Then ValCell = "£" Else ValCell = Cells(C.Row, i) & "£"
            X = X & ValCell
        Next i
        DebC = C
        C = X
        DicoF3.Add C, ""
        C = DebC
        X = ""
    Next C
    f1.Activate
    [B2].Resize(DicoF3.Count) = Application.Transpose(DicoF3.keys)
    
    DerLigF1 = Application.WorksheetFunction.Max(DerLigF2, DerLigF3)
    Range("C2:C" & DerLigF1).FormulaR1C1 = "=IF(RC[-2]=RC[-1],"""",""Ecart"")"
    Range("A1") = Fichier1
    Range("B1") = Fichier2
    Range("C1") = "'Test"
    Columns("A:B").Select
    Selection.EntireColumn.AutoFit
    Selection.Replace What:="£", Replacement:="  ", LookAt:=xlPart
    For i = 1 To 10
        Cells.Replace What:="  ", Replacement:=" ", LookAt:=xlPart
    Next i
    Range("A1:C1").AutoFilter
    ActiveSheet.Range("A1:C" & DerLigF1).AutoFilter Field:=3, Criteria1:="Ecart"
End Sub

Extraire différence entre deux fichiers excel

3 réponses

Discussions similaires