Macro

Question

Bonjour à tous, 

J'ai besoin d'aide, pour une macro qui permette de chercher les différence entre deux fichiers,


Le 1 er fichier concerne des informations, saisies par mon fournisseur et dans le 2eme des informations saisies par moi. L'idée est de vérifier si il existe des différences entre les deux fichiers.

dans un meme classeur j'aimerais avoir 3 onglets ( feuille  1: mes informations, feuille 2: les info de mon fournisseur, et feuille 3 (Analyse: un bouton de commande qui permette d'affichier le résultat )

En vous remerciant pour votre retour

Frenchie83 · Answer

Bonjour,
Je suppose que les feuilles 1 et 2 sont identiques, essaies ce petit bout de programme, le résultat s'affiche en feuille 3 en te donnant en colonne A l'emplacement de la cellule dont le contenu est différent d'une feuille à l'autre, en B tes infos et en C celle du fournisseur. Tu n'as plus qu'à créer un bouton sur la feuille 3 et lui affecter la macro ci-dessous

en espérant que cela te convienne.


Option Compare Text

Sub ControleDesDonnees()
    Application.ScreenUpdating = False
    Dim DetectionDifference As Boolean
    'nettoyage de la feuille de résultats ***************************************
    Sheets(3).Cells.ClearContents
    
    'Recherche la dernière cellule de la feuille 1 "Mes infos  "  ****************
    Sheets(1).Select
    DerniereLigne1 = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
    DerniereColonne1 = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column
    
    'Recherche la dernière cellule de la feuille 2 "Infos fournisseur "***********
    Sheets(2).Select
    DerniereLigne2 = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
    DerniereColonne2 = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column
    
    'Prendre comme référence la derniere cellule celle situé la plus basse et la plus à droite parmi les 2 feuilles ****
    If DerniereLigne1 >= DerniereLigne2 Then
        DerniereLigne = DerniereLigne1
    Else
        DerniereLigne = DerniereLigne2
    End If
    If DerniereColonne1 >= DerniereColonne2 Then
        DerniereColonne = DerniereColonne1
    Else
        DerniereColonne = DerniereColonne2
    End If
    
    DetectionDifference = False
    
    ReDim MesInfos(DerniereLigne & DerniereColonne) As String
    ReDim InfosFournisseur(DerniereLigne & DerniereColonne) As String
    ReDim Ecart(DerniereLigne & DerniereColonne) As String
    ReDim Cellule(DerniereLigne & DerniereColonne) As String
    
    For i = 1 To DerniereLigne
        For j = 1 To DerniereColonne
            If Sheets(1).Cells(i, j) <> Sheets(2).Cells(i, j) Then
                k = CInt(i & j)
                MesInfos(k) = Sheets(1).Cells(i, j)
                InfosFournisseur(k) = Sheets(2).Cells(i, j)
                Cellule(k) = Sheets(1).Cells(i, j).Address
                Ecart(k) = i & j
                DetectionDifference = True
            End If
        Next j
    Next i
    
    If DetectionDifference = False Then
        MsgBox "Pas d'écart constaté"
        Exit Sub
    End If
    
    Sheets(3).Select
    Range("A2").Select
    Do While Not IsEmpty(ActiveCell)
        ActiveCell.Offset(1, 0).Select
    Loop
    For i = 1 To DerniereLigne
        For j = 1 To DerniereColonne
            k = CInt(i & j)
            If Ecart(k) = "" Then GoTo Suivant
            ActiveCell.Value = Cellule(k)
            ActiveCell.Offset(0, 1).Value = MesInfos(k)
            ActiveCell.Offset(0, 2).Value = InfosFournisseur(k)
            ActiveCell.Offset(1, 0).Select
Suivant:
        Next j
    Next i
    
    'Affichage des entêtes *************************
    Range("A1").Value = "Emplacement cellules"
    Range("B1").Value = "Mes infos"
    Range("C1").Value = "infos Fournisseur"
    Range("A1:C1").MergeCells = False
End Sub

Macro

1 réponse

Discussions similaires

Newsletters