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

Comparer deux fichiers ayant la même structure

  • Initiateur de la discussion Initiateur de la discussion wyzer
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

wyzer

XLDnaute Nouveau
Bonjour,

Tous les mois je reçois un nouveau fichier m'indiquant les modification à apporter au compte client

Donc pourriez-vous me dire comment faire pour faire ça en VBA :

- demander d'ouvrir le fichier de référence
- demander d'ouvrir le nouveau fichier
- créer un troisième fichier, et y copier les lignes différentes

Dans ce troisème fichier on pourrait utiliser des codes couleurs de ce genre :

Rouge = supression
Orange = modification


Merci par avance !!!


Voici un code que j'ai trouvé sur Google :

Code:
Sub Comparer_2_fichiers()
Dim iLRA%, iLRN%, i%, j%, k%
Dim Y As Boolean, Ys As Boolean
Dim TabloA(), TabloN()
Dim wba As Workbook, wbn As Workbook
Dim WsA As Worksheet, WsN As Worksheet
'Détermination du nombre de ligne de Classeur "Ancien" et "Nouveau"
Set wba = Workbooks("ancien.xls")
Set wbn = Workbooks("nouveau.xls")
Set WsA = wba.Worksheets(1)
Set WsN = wbn.Worksheets(1)
iLRA = WsA.Cells(65535, 1).End(xlUp).Row
iLRB = WsN.Cells(65535, 1).End(xlUp).Row
TabloA() = WsA.Range("A1:A" & iLRA)
TabloN() = WsN.Range("A1:A" & iLRB)
 
'Détermination des absents
For i = 1 To UBound(TabloA)
  For j = 1 To UBound(TabloN)
    'Si égalité alors on pose un drapeau
    If TabloN(j, 1) = TabloA(i, 1) Then
      Y = True
      'et on vérifie la ligne si c'est une égalité stricte
        For k = 1 To 70 'nombre de colonne a tester
          'si différence on pose un drapeau
          If WsA.Cells(i, k) <> WsN.Cells(j, k) Then
            Ys = True
            'et on colore en orange
            WsN.Cells(j, k).Interior.ColorIndex = 45
            WsN.Cells(j, 1).Interior.ColorIndex = 45
          End If
        Next
          'sinon 1ere cellule en vert
          If Not Ys Then WsN.Cells(j, 1).Interior.ColorIndex = 4
        Ys = False
      Exit For
    End If
  Next
  'Si pas trouvé alors on colorie en rouge
  If Not Y Then WsN.Range("A" & j).Interior.ColorIndex = 3
  Y = False
   
   
Next
Set wba = Nothing
Set wbn = Nothing
Set WsA = Nothing
Set WsN = Nothing
 
Call Comparer_2_fichiers_2
 
End Sub
 
 
 
Sub Comparer_2_fichiers_2()
Dim iLRA%, iLRN%, i%, j%, k%
Dim Y As Boolean, Ys As Boolean
Dim TabloA(), TabloN()
Dim wba As Workbook, wbn As Workbook
Dim WsA As Worksheet, WsN As Worksheet
'Détermination du nombre de ligne de Classeur "Ancien" et "Nouveau"
Set wba = Workbooks("ancien.xls")
Set wbn = Workbooks("nouveau.xls")
Set WsA = wba.Worksheets(1)
Set WsN = wbn.Worksheets(1)
iLRA = WsA.Cells(65535, 1).End(xlUp).Row
iLRB = WsN.Cells(65535, 1).End(xlUp).Row
TabloA() = WsA.Range("A1:A" & iLRA)
TabloN() = WsN.Range("A1:A" & iLRB)
 
Y = False
 
'Détermination des absents
For j = 1 To UBound(TabloN)
 
  For i = 1 To UBound(TabloA)
    'Si égalité alors on pose un drapeau
    If TabloA(i, 1) = TabloN(j, 1) Then
      Y = True
      Exit For
    End If
  Next
  'Si pas trouvé alors on colorie en rouge
  If Not Y Then WsN.Range("A" & j).Interior.ColorIndex = 3
  Y = False
   
   
Next
 
Set wba = Nothing
Set wbn = Nothing
Set WsA = Nothing
Set WsN = Nothing
 
End Sub
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
4
Affichages
581
  • Question Question
Microsoft 365 Export données
Réponses
4
Affichages
809
  • Question Question
Microsoft 365 VBA sur outlook
Réponses
14
Affichages
1 K
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…