Microsoft 365 comparaison de 2 xls

thenesol · 19 Août 2022

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

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

une idée...?
merci !

JHA · 19 Août 2022

Bonjour à tous,

Pas le courage de tout retaper mais as-tu essayé power query?

JHA

Deadpool_CC · 19 Août 2022

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 · 19 Août 2022

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

job75 · 20 Août 2022

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+

thenesol · 20 Août 2022

nbre de ligne max disons 2000

uniquement rechercher celles de N+1 qui ne sont pas dans N

merci !!

job75 · 20 Août 2022

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.

thenesol · 20 Août 2022

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

job75 · 20 Août 2022

Oui on sort de la 2ème boucle dès que la correspondance est trouvée.

J'ai testé en recopiant chaque tableau source sur 2000 lignes.

Et en effet c'est rapide, la macro s'exécute chez moi en 0,68 seconde.

thenesol · 20 Août 2022

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 ?

thenesol · 20 Août 2022

je pense avoir trouvé
avec Set wb1 = Workbooks.Open(Fichier1)
ça fonctionne

merci encore !!!

thenesol · 21 Août 2022

bonjour
ça marche toujours parfaitement
question : si je veux rajouter 2 ou 3 colonnes de comparaison (voire nbre paramétrable), comment faire ?
j'ai essayé de bidouiller le code sans grand succès...
merci encore
Raphaël

job75 · 21 Août 2022

Bonjour thenesol, le forum,

thenesol à dit:
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+

thenesol · 7 Septembre 2022

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

Date	Libellé
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 :

Date	Libellé
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

Microsoft 365 comparaison de 2 xls

thenesol

XLDnaute Junior

JHA

XLDnaute Barbatruc

Deadpool_CC

XLDnaute Accro

rafi93

XLDnaute Occasionnel

Pièces jointes

job75

XLDnaute Barbatruc

thenesol

XLDnaute Junior

job75

XLDnaute Barbatruc

Pièces jointes

thenesol

XLDnaute Junior

job75

XLDnaute Barbatruc

thenesol

XLDnaute Junior

thenesol

XLDnaute Junior

thenesol

XLDnaute Junior

job75

XLDnaute Barbatruc

Pièces jointes

thenesol

XLDnaute Junior

Discussions similaires