Comparer deux fichiers ayant la même structure

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
 

Discussions similaires

Réponses
0
Affichages
172

Membres actuellement en ligne

Aucun membre en ligne actuellement.

Statistiques des forums

Discussions
312 393
Messages
2 088 006
Membres
103 696
dernier inscrit
lgerbaud