Microsoft 365 comparaison de 2 xls

thenesol

XLDnaute Junior
bonjour à tous

je souhaite pouvoir comparer 2 fichiers xls, mais les méthodes existantes ne conviennent pas, je m'explique :

il s'agit de télécharger périodiquement des comptes bancaires, et entre la version N+1 et N du téléchargement identifier les "nouvelles" lignes.

le 1er problème est que les fichiers sont à chaque fois fournis triés par date : les "nouvelles" lignes peuvent donc se trouver ailleurs qu'en fin de liste de N+1

le 2eme problème plus délicat est que certaines lignes peuvent être doublonnées sans que ce soit une erreur : plusieurs dépenses identiques le même jour.

je n'arrive pas à trouver de méthode simple (pas très balèze en vba) pour extraire le véritable différentiel entre N et N+1

voir cet exemple

version N
1660919421148.png


version N+1
les lignes en jaune sont les nouvelles à extraire,
mais les comparaisons de fichiers ne mettent pas en évidence les lignes 3 et 4 qui ont été enregistrées par la banque postérieurement à l'édition de la version N

1660919457845.png


une idée...?
merci !
 

Deadpool_CC

XLDnaute Accro
Bonjour,
C'est ce que j'allais dire (@JHA est sur la même logique) ... un fichier Exemple en excel SVP et fichier excel à insérer ou il y a doublon et anciennes opérations déjà insérées ...
car faut voir les données dispo pour chaque opération pour pouvoir être certain d'identifier les doublon ou opération déjà réalisées en fonction de ce qu'il y a de dispo pour chaque ligne (un ID ? ou alors un ensemble de données qui garantisse l'unicité de la ligne)
 

rafi93

XLDnaute Occasionnel
ok, (je pensais que ce serait plus simple à lire avec les copies d'écran)
ci joints 2 fichiers : version N et version N+1.
en jaune dans N+1 ce qui est considéré comme "nouveau" par rapport à N.
il n'y a pas d'ID commun aux 2 fichiers (ce serait trop simple...)
😗
l'objectif est donc de créer un 3ème fichier ne contenant que les lignes jaunes
 

Pièces jointes

  • tstcompare 2.xlsx
    10.4 KB · Affichages: 6
  • tstcompare 1.xlsx
    10.4 KB · Affichages: 6
Dernière édition:

job75

XLDnaute Barbatruc
Bonjour à tous,

1. Quel est le nombre de lignes maximum des fichiers ?

2. Vous voulez rechercher les lignes du fichier N+1 qui ne sont pas dans le fichier N. Faut-il aussi rechercher les lignes du fichier N qui ne sont pas dans le fichier N+1 ?

A+
 

job75

XLDnaute Barbatruc
Une solution très bateau consiste à utiliser 2 boucles imbriquées.

Voyez les fichiers joints et la macro du bouton :
VB:
Sub Compare()
Dim fichier1$, fichier2$, wb1 As Workbook, wb2 As Workbook, tablo1, tablo2, ub&, i&, x, y, j&, resu(), n&
fichier1 = "Fichier N.xlsx" 'à adapter
fichier2 = "Fichier N+1.xlsx" 'à adapter
On Error Resume Next
Set wb1 = Workbooks(fichier1)
If wb1 Is Nothing Then MsgBox "Ouvrez '" & fichier1 & "'...": Exit Sub
Set wb2 = Workbooks(fichier2)
If wb2 Is Nothing Then MsgBox "Ouvrez '" & fichier2 & "'...": Exit Sub
tablo1 = wb1.Sheets(1).[A1].CurrentRegion.Resize(, 3) 'matrice, plus rapide
ub = UBound(tablo1)
tablo2 = wb2.Sheets(1).[A1].CurrentRegion.Resize(, 3) 'matrice, plus rapide
For i = 1 To UBound(tablo2)
    If tablo2(i, 3) <> Chr(1) Then
        x = tablo2(i, 1): y = tablo2(i, 2)
        For j = 1 To ub
            If tablo1(j, 1) = x And tablo1(j, 2) = y And tablo1(j, 3) <> Chr(1) Then
                tablo1(j, 3) = Chr(1) 'repère
                tablo2(i, 3) = Chr(1) 'repère
                Exit For
            End If
        Next j
    End If
Next i
'---tableau des résultats---
ReDim resu(1 To UBound(tablo2), 1 To 3)
For i = 1 To UBound(tablo2)
    If tablo2(i, 3) <> Chr(1) Then
        n = n + 1
        resu(n, 1) = i
        resu(n, 2) = tablo2(i, 1)
        resu(n, 3) = tablo2(i, 2)
    End If
Next i
'---restitution---
With ThisWorkbook.ActiveSheet 'adapter au besoin
    .Activate
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    With .[A2] '1ère cellule de destination
        If n Then .Resize(n, 3) = resu
        .Offset(n).Resize(Rows.Count - n - .Row + 1, 3).ClearContents 'RAZ en dessous
        .Resize(, 3).EntireColumn.AutoFit 'ajuste les largeurs
    End With
    With .UsedRange: End With 'actualise la barre de défilement verticale
End With
End Sub
Si les fichiers font chacun 2000 lignes cela peut faire 4 000 000 de cas à étudier, ce sera assez long.
 

Pièces jointes

  • Comparaison(1).xlsm
    20.6 KB · Affichages: 3
  • Fichier N.xlsx
    10.4 KB · Affichages: 4
  • Fichier N+1.xlsx
    10.4 KB · Affichages: 4

thenesol

XLDnaute Junior
super merci

une question avant que je m'y plonge : est ce que dès qu'il trouve une correspondance, il arrête bien la recherche et passe au suivant?

car comme les fichiers n'ont généralement que quelques dizaines de lignes de différence, ça devrait accelerer
 

thenesol

XLDnaute Junior
bon, c'est presque bon !

ça marche au poil avec tes 2 fichiers exemple (qu'il faut donc ouvrir avant de lancer la macro)

pour sélectionner mes données j'ai rajouté
Fichier1 = Application.GetOpenFilename
If Fichier1 = False Then Exit Sub ' pas de fichier on quitte
Fichier2 = Application.GetOpenFilename
If Fichier2 = False Then Exit Sub ' pas de fichier on quitte

mais ça plante sur la ligne
If wb1 Is Nothing Then MsgBox "Ouvrez '" & Fichier1 & "'...": Exit Sub

pourquoi ?
 

job75

XLDnaute Barbatruc
Bonjour thenesol, le forum,
question : si je veux rajouter 2 ou 3 colonnes de comparaison (voire nbre paramétrable), comment faire ?
Voyez ce fichier (2) et la variable ncol :
VB:
Sub Compare()
Dim ncol%, fichier1$, fichier2$, wb1 As Workbook, wb2 As Workbook, tablo1, ub&, tablo2, i&, x$, j%, ii&, y$, resu(), n&
ncol = 4 'nombre de colonnes à adapter, 1 colonne de plus que dans les tableaux sources
fichier1 = "Fichier N.xlsx" 'à adapter
fichier2 = "Fichier N+1.xlsx" 'à adapter
On Error Resume Next
Set wb1 = Workbooks(fichier1)
If wb1 Is Nothing Then MsgBox "Ouvrez '" & fichier1 & "'...": Exit Sub
Set wb2 = Workbooks(fichier2)
If wb2 Is Nothing Then MsgBox "Ouvrez '" & fichier2 & "'...": Exit Sub
tablo1 = wb1.Sheets(1).[A1].CurrentRegion.Resize(, ncol) 'matrice, plus rapide
ub = UBound(tablo1)
tablo2 = wb2.Sheets(1).[A1].CurrentRegion.Resize(, ncol) 'matrice, plus rapide
For i = 1 To UBound(tablo2)
    If tablo2(i, ncol) <> Chr(1) Then
        x = ""
        For j = 1 To ncol: x = x & Chr(1) & tablo2(i, j): Next j 'concaténation
        For ii = 1 To ub
            y = ""
            For j = 1 To ncol: y = y & Chr(1) & tablo1(ii, j): Next j 'concaténation
            If x = y Then
                tablo1(ii, ncol) = Chr(1) 'repère
                tablo2(i, ncol) = Chr(1) 'repère
                Exit For
            End If
        Next ii
    End If
Next i
'---tableau des résultats---
ReDim resu(1 To UBound(tablo2), 1 To ncol)
For i = 1 To UBound(tablo2)
    If tablo2(i, ncol) <> Chr(1) Then
        n = n + 1
        resu(n, 1) = i
        For j = 2 To ncol: resu(n, j) = tablo2(i, j - 1): Next j
    End If
Next i
'---restitution---
With ThisWorkbook.ActiveSheet 'adapter au besoin
    .Activate
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    With .[A2] '1ère cellule de destination
        If n Then .Resize(n, ncol) = resu
        .Offset(n).Resize(Rows.Count - n - .Row + 1, ncol).ClearContents 'RAZ en dessous
        .Resize(, ncol).EntireColumn.AutoFit 'ajuste les largeurs
    End With
    With .UsedRange: End With 'actualise la barre de défilement verticale
End With
End Sub
A+
 

Pièces jointes

  • Comparaison(2).xlsm
    21.2 KB · Affichages: 3
  • Fichier N.xlsx
    10.4 KB · Affichages: 2
  • Fichier N+1.xlsx
    10.6 KB · Affichages: 2

thenesol

XLDnaute Junior
bonjour job75 !

me revoila,
ça marchait nickel
puis j'ai fait une petite modif dans le code pour pouvoir mettre cette macro dans mon personal.xlsb et la lancer depuis un fichier spécifique

mais j'ai un pb : à l'ouverture de "old.csv" et "new.csv" ci joints, il m'inverse les jj/mm de la colonne date,
c'est à dire que le 01/09/2022 devient 09/01/2022, etc

je ne comprends pas pourquoi

une idée ?
merci encore

VB:
Option Explicit

Sub compare()
Dim ncol%, wb1 As Workbook, wb2 As Workbook, tablo1, ub&, tablo2, i&, x$, j%, ii&, y$, resu(), n&
Dim ws1 As Worksheet
Dim Fichier1 As Variant
Dim Fichier2 As Variant
'''fichier1 = "Fichier N.xlsx" 'à adapter
'''fichier2 = "Fichier N+1.xlsx" 'à adapter

'  fichier1 = Application.GetOpenFilename("Fichier XLS (*.xls),*.xls")
'  If fichier1 = False Then Exit Sub                                      ' pas de fichier on quitte
'  fichier2 = Application.GetOpenFilename("Fichier XLS (*.xls),*.xls")
'  If fichier2 = False Then Exit Sub                                      ' pas de fichier on quitte
 
ncol = 10
Set ws1 = ActiveSheet


  Fichier1 = Application.GetOpenFilename
  If Fichier1 = False Then MsgBox "Ouvrez '" & Fichier1 & "'...": Exit Sub                                      ' pas de fichier on quitte
  Fichier2 = Application.GetOpenFilename
  If Fichier2 = False Then MsgBox "Ouvrez '" & Fichier2 & "'...": Exit Sub                                      ' pas de fichier on quitte
 
On Error Resume Next
Set wb1 = Workbooks.Open(Fichier1)
If wb1 Is Nothing Then MsgBox "Ouvrez '" & Fichier1 & "'...": Exit Sub
Set wb2 = Workbooks.Open(Fichier2)
If wb2 Is Nothing Then MsgBox "Ouvrez '" & Fichier2 & "'...": Exit Sub

tablo1 = wb1.Sheets(1).[A1].CurrentRegion.Resize(, ncol) 'matrice, plus rapide
ub = UBound(tablo1)
tablo2 = wb2.Sheets(1).[A1].CurrentRegion.Resize(, ncol) 'matrice, plus rapide
For i = 1 To UBound(tablo2)
    If tablo2(i, ncol) <> Chr(1) Then
        x = ""
        For j = 1 To ncol: x = x & Chr(1) & tablo2(i, j): Next j 'concaténation
        For ii = 1 To ub
            y = ""
            For j = 1 To ncol: y = y & Chr(1) & tablo1(ii, j): Next j 'concaténation
            If x = y Then
                tablo1(ii, ncol) = Chr(1) 'repère
                tablo2(i, ncol) = Chr(1) 'repère
                Exit For
            End If
        Next ii
    End If
Next i
'---tableau des résultats---
ReDim resu(1 To UBound(tablo2), 1 To ncol)
For i = 1 To UBound(tablo2)
    If tablo2(i, ncol) <> Chr(1) Then
        n = n + 1
        resu(n, 1) = i
        For j = 2 To ncol: resu(n, j) = tablo2(i, j - 1): Next j
    End If
Next i
'---restitution---
With ws1 'adapter au besoin
    .Activate
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    With .[A2] '1ère cellule de destination
        If n Then .Resize(n, ncol) = resu
        .Offset(n).Resize(Rows.Count - n - .row + 1, ncol).ClearContents 'RAZ en dessous
        .Resize(, ncol).EntireColumn.AutoFit 'ajuste les largeurs
    End With
    With .UsedRange: End With 'actualise la barre de défilement verticale
End With
End Sub



bon, impossible de joindre un csv, je copie les données ici
pour old.csv
DateLibellé
05/09/2022​
lib1
05/09/2022​
lib2
05/09/2022​
lib3
05/09/2022​
lib4
05/09/2022​
lib5
05/09/2022​
lib6
03/09/2022​
lib7
02/09/2022​
lib8
02/09/2022​
lib9
02/09/2022​
lib10
02/09/2022​
lib11
02/09/2022​
lib12
02/09/2022​
lib13
02/09/2022​
lib14
02/09/2022​
lib15
02/09/2022​
lib16
02/09/2022​
lib17
02/09/2022​
lib18
02/09/2022​
lib19
01/09/2022​
lib20
01/09/2022​
lib21
01/09/2022​
lib22
01/09/2022​
lib23
01/09/2022​
lib24
01/09/2022​
lib25
01/09/2022​
lib26
01/09/2022​
lib27

new.csv :
DateLibellé
30/09/2022​
lib1
07/09/2022​
lib2
07/09/2022​
lib3
07/09/2022​
lib4
06/09/2022​
lib5
06/09/2022​
lib6
06/09/2022​
lib7
06/09/2022​
lib8
06/09/2022​
lib9
06/09/2022​
lib10
06/09/2022​
lib11
05/09/2022​
lib12
05/09/2022​
lib13
05/09/2022​
lib14
05/09/2022​
lib15
05/09/2022​
lib16
05/09/2022​
lib17
05/09/2022​
lib18
05/09/2022​
lib19
05/09/2022​
lib20
05/09/2022​
lib21
05/09/2022​
lib22
05/09/2022​
lib23
05/09/2022​
lib24
05/09/2022​
lib25
05/09/2022​
lib26
05/09/2022​
lib27
05/09/2022​
lib28
05/09/2022​
lib29
05/09/2022​
lib30
 

Discussions similaires

Statistiques des forums

Discussions
311 729
Messages
2 081 970
Membres
101 852
dernier inscrit
dthi16088