Extraire et comparer feuilles excel -macro

fleur

XLDnaute Nouveau
Bonjour


Je voudrais de laide pour une macro afin de chercher et comparer les memes "references" qui se trouve dans mes feuilles Source A et Source B afin de reporter "les references" identique dans ma feuilles Resultat.
Cela en reportant les lignes correspondantes qui se trouve dans ma feuille source B; (voir exemple sur feuille)


J ai juste deux conditions pour le code VBA , c' est ques " les montants" qui different pour" les references" identiques soit souligné en rouge dans ma feuille resultat ;

Et que les lignes qui ont les "reference"identiques doivent disparaitre des feuilles source A et B; apres être afficher sur la feuille resultat



J' ai besoin de programmer ce code vba avec un bouton,

Pourriez vous m'aider pour un code vba pour remplir ces conditions, jai mis mon fichier en piece jointe



Merci d avances les experts

fleur
 

Fichiers joints

Modeste

XLDnaute Barbatruc
Re : Extraire et comparer feuilles excel -macro

Bonjour fleur,

Pas sûr de comprendre:
- toutes tes références sont identiques dans les feuilles Source A et Source B ... les deux feuilles seront donc vierges, après exécution de la macro!?
- une même référence peut-elle être présente plus d'une fois dans une des deux feuilles "Source"?
- dans la feuille résultat, tu as vraiment besoin de recopier les références dans deux colonnes et les dates dans deux autres?
- quand tu parles de références identiques, on ne considère que la référence elle-même ou faut-il s'assurer que la date est aussi la même dans les 2 feuilles?

Si je me charge de créer le bouton, tu écris la macro? Le deal te convient?

PS: je te propose de laisser tomber le terme "experts" (comme je ne me considère nullement comme tel, j'hésite avant de répondre)
 

Dranreb

XLDnaute Barbatruc
Re : Extraire et comparer feuilles excel -macro

Bonjour.

J'avais aussi observé que là, les références de vos deux listes sont identique et dans le même désordre. C'est facile: il suffit de faire des copier coller des 3 colonnes de gauche de la Feuil1 en A puis les 6 de gauche de la Feuil2 en D. Il ne reste qu'à mettre une MeFC sur B et E qui repère les différences. L'enregistreur de macro vous en fera un bon brouillon de départ.
Sinon j'aurai une solution avec des listes différentes qui reclasserait le tout par références.

Le code est déjà fait (un peu trop vite peut être) :
VB:
Private Sub Worksheet_Activate()
Dim Réf As SsGroup, T(), L&, Détail, C&
ReDim T(1 To 500, 1 To 9)
For Each Réf In GroupOrg(TableUnique(PlgUti(Feuil1.[A2]), PlgUti(Feuil2.[A2])), 1)
   L = L + 1
   For Each Détail In Réf.Contenu
      If Détail(0) = 0 Then
         For C = 1 To 3: T(L, C) = Détail(C): Next C
      Else
         For C = 1 To 6: T(L, C + 3) = Détail(C): Next C
         End If: Next Détail, Réf
Me.[A3:I3].Resize(L).Value2 = T
End Sub
Nécessite quelques modules de service
 
Dernière édition:

fleur

XLDnaute Nouveau
Re : Extraire et comparer feuilles excel -macro

Bonjour


Merci pour cette piste mais c ' etait juste l ' exemple les references se retrouvent normalement en désordre donC il me faut le code pour pouvoir les rechercher dans le desordre et les remettre dans l ordre sur la feuille resultat et puis effacer les lignes qui ont les references identique apres qu elle sont mise en ordre sur la feuille resultat et les la colone montant comparer.


Je te remercie pour ton aide

fleur
 

fleur

XLDnaute Nouveau
Re : Extraire et comparer feuilles excel -macro

Bonjour Modeste

Ton deal n est pas mal du tout mais je suis novis en VBA, donc je prefere juste creer le bouton.

Concernant les point soulever:

-les references ne sont pas toutes normalement identique donc c ' est pour cela que je prefere que les lignes qui n' ont pas les references identiques dans la feuile source A et B reste dessus et celle qui sont identiques disparaisse aprés êtres affichier sur la feuille resultat.
-Oui j ' en ai besoin car les dates peuvent etre differente
-Non il faut considerer seulement les references , car les dates peuvent être differente.

Je te remercie pour ton aide , désolé pour le mot expert vaut mieux dire passionné.

Fleur
 

job75

XLDnaute Barbatruc
Re : Extraire et comparer feuilles excel -macro

Bonjour fleur, Modeste, Bernard,

Et que les lignes qui ont les "reference"identiques doivent disparaitre des feuilles source A et B; apres être afficher sur la feuille resultat
Ce n'est pas une très bonne idée car cela alourdirait le traitement et rendrait impossible une 2ème exécution de cette macro :

Code:
Private Sub Worksheet_Activate()
Dim F1 As Worksheet, F2 As Worksheet, ncol%
Dim t, t1, ub&, a(), i&, x, j&, k%
Set F1 = Feuil1: Set F2 = Feuil2 'CodeNames
ncol = 3 'nombre de colonnes du tableau Source A
Application.ScreenUpdating = False
Rows("3:" & Rows.Count).Delete 'RAZ
F2.UsedRange.Offset(1).Copy [A3].Offset(, ncol)
Me.UsedRange.Offset(1).Sort Columns(ncol + 1), Header:=xlYes 'tri
t = Me.UsedRange.Offset(1)
t1 = F1.UsedRange.Resize(, ncol): ub = UBound(t1)
ReDim a(1 To UBound(t), 1 To ncol)
For i = 2 To UBound(t)
  x = t(i, ncol + 1)
  If x <> t(i - 1, ncol + 1) Then 'évite les doublons
    For j = 2 To ub
      If x = t1(j, 1) Then
        For k = 1 To ncol
          a(i - 1, k) = t1(j, k)
        Next
        Exit For
      End If
    Next
  End If
Next
[A3].Resize(i - 1, ncol) = a
'--suppression des cellules vides en colonne A---
Me.UsedRange.Offset(1).Sort Columns(1), Header:=xlYes 'tri
On Error Resume Next
Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
Dans les 2 tableaux sources les références en doublon sont éliminées s'il y en a.

Fichier joint.

A+
 

Fichiers joints

Dranreb

XLDnaute Barbatruc
Re : Extraire et comparer feuilles excel -macro

Bonjour

Je n'avais pas vu qu'il fallait effacer les références identiques des feuilles A et B.
Faut-il le faire que leurs montants soient identiques ou non ?
N'est-ce pas un peu dangereux ? On risque de les perdre définitivement chaque fois qu'on active la feuille Résultat. A moins qu'il ne faille aussi tenir compte de ce qu'elle contient déjà, pour le préserver ?
Mais alors j'aurais besoin que la référence n'y soit qu'une fois en colonne A, et non répétée en colonne D
Les références qui n'existent pas à la fois en A et B doivent elles quand même être reproduites en Résultat ?

Vous auriez quand même dû mettre un exemple montrant tous les cas !
En attendant voici ce que j'avais écrit, muni des modules de service.
 

Fichiers joints

Dernière édition:

job75

XLDnaute Barbatruc
Re : Extraire et comparer feuilles excel -macro

Message annulé.
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
Re : Extraire et comparer feuilles excel -macro

La version qui analyse les 3 feuilles, met toujours tout dans la feuille Résultat, mais ne conserve pas les réf. identiques dans la A et B.
 

Fichiers joints

job75

XLDnaute Barbatruc
Re : Extraire et comparer feuilles excel -macro

Re,

Plutôt que modifier 'Source A" et "Source B" on utilise maintenant les feuilles "Source A allégée" et "Source B allégée".

La macro dans la feuille "Resultat" n'est pas beaucoup plus compliquée :

Code:
Private Sub Worksheet_Activate()
Dim F1 As Worksheet, F2 As Worksheet, ncol%
Dim t, t1, ub&, t2, a(), i&, x, j&, k%
Set F1 = Feuil4: Set F2 = Feuil5 'CodeNames
ncol = 3 'nombre de colonnes du tableau Source A
Application.ScreenUpdating = False
Feuil1.Cells.Copy F1.Cells
Feuil2.Cells.Copy F2.Cells
F1.UsedRange.Sort F1.Columns(1), Header:=xlYes 'tri
F2.UsedRange.Sort F2.Columns(1), Header:=xlYes 'tri
Rows("3:" & Rows.Count).Delete 'RAZ
F2.UsedRange.Offset(1).Copy [A3].Offset(, ncol)
t = Me.UsedRange.Offset(1)
t1 = F1.UsedRange.Resize(, ncol): ub = UBound(t1)
t2 = F2.UsedRange.Resize(UBound(t))
ReDim a(1 To UBound(t), 1 To ncol)
For i = 2 To UBound(t)
  x = t(i, ncol + 1)
  If x <> t(i - 1, ncol + 1) Then 'évite les doublons
    For j = 2 To ub
      If x = t1(j, 1) Then
        For k = 1 To ncol
          a(i - 1, k) = t1(j, k)
        Next k
        t1(j, 1) = Empty
        t2(i, 1) = Empty
        Exit For
      End If
    Next j
  End If
Next i
[A3].Resize(i - 1, ncol) = a
F1.UsedRange.Resize(, ncol) = t1
F2.UsedRange = t2
'--suppression des cellules vides en colonne A---
Me.UsedRange.Offset(1).Sort Columns(1), Header:=xlYes 'tri
F1.UsedRange.Sort F1.Columns(1), Header:=xlYes 'tri
F2.UsedRange.Sort F2.Columns(1), Header:=xlYes 'tri
On Error Resume Next
Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
F1.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
F2.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
Faites bien attention pour adapter : on n'utilise que les CodeNames des feuilles.

Fichier (2).

A+
 

Fichiers joints

Dernière édition:

job75

XLDnaute Barbatruc
Re : Extraire et comparer feuilles excel -macro

Bonjour le fil, le forum,

Dans ce fichier (3) la macro est placée dans ThisWorkbook.

Surtout, Feuil4 étant triée, la variable deb permet d'accélérer la 2ème boucle (j) :

Code:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim a, F As Worksheet, F1 As Worksheet, F2 As Worksheet
Dim ncol%, t, t1, ub&, t2, deb&, i&, x, j&, k%
a = Array("Feuil3", "Feuil4", "Feuil5") 'CodeNames des feuilles
If IsError(Application.Match(Sh.CodeName, a, 0)) Then Exit Sub
Set F = Feuil3: Set F1 = Feuil4: Set F2 = Feuil5
ncol = 3 'nombre de colonnes du tableau Source A
Application.ScreenUpdating = False
Feuil1.Cells.Copy F1.Cells
Feuil2.Cells.Copy F2.Cells
F1.UsedRange.Sort F1.Columns(1), Header:=xlYes 'tri
F2.UsedRange.Sort F2.Columns(1), Header:=xlYes 'tri
F.Rows("3:" & F.Rows.Count).Delete 'RAZ
F2.UsedRange.Offset(1).Copy F.[A3].Offset(, ncol)
t = F.UsedRange.Offset(1)
t1 = F1.UsedRange.Resize(, ncol): ub = UBound(t1)
t2 = F2.UsedRange.Resize(UBound(t))
ReDim a(1 To UBound(t), 1 To ncol)
deb = 2
For i = 2 To UBound(t)
  x = t(i, ncol + 1)
  If x <> t(i - 1, ncol + 1) Then 'évite les doublons
    For j = deb To ub
      If x = t1(j, 1) Then
        For k = 1 To ncol
          a(i - 1, k) = t1(j, k)
        Next k
        t1(j, 1) = Empty
        t2(i, 1) = Empty
        deb = j + 1
        Exit For
      End If
    Next j
  End If
Next i
F.[A3].Resize(i - 1, ncol) = a
F1.UsedRange.Resize(, ncol) = t1
F2.UsedRange = t2
'--suppression des cellules vides en colonne A---
F.UsedRange.Offset(1).Sort F.Columns(1), Header:=xlYes 'tri
F1.UsedRange.Sort F1.Columns(1), Header:=xlYes 'tri
F2.UsedRange.Sort F2.Columns(1), Header:=xlYes 'tri
On Error Resume Next
F.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
F1.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
F2.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
Edit important : les colonnes A de toutes les feuilles doivent être au même format, ici le format Texte.

"Source A" ne l'était pas et cela aurait pu causer des soucis...

Bonne journée.
 

Fichiers joints

Dernière édition:

job75

XLDnaute Barbatruc
Re : Extraire et comparer feuilles excel -macro

Re,

S'il peut y avoir des références en doublon il est intéressant de les signaler dans "Source A allégée" et "Source B allégée" :

Code:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim a, F As Worksheet, F1 As Worksheet, F2 As Worksheet
Dim ncol%, t, t1, ub&, t2, doublon1(), doublon2(), deb&, i&, x, j&, k%
a = Array("Feuil3", "Feuil4", "Feuil5") 'CodeNames des feuilles
If IsError(Application.Match(Sh.CodeName, a, 0)) Then Exit Sub
Set F = Feuil3: Set F1 = Feuil4: Set F2 = Feuil5
ncol = 3 'nombre de colonnes du tableau Source A
Application.ScreenUpdating = False
Feuil1.Cells.Copy F1.Cells
Feuil2.Cells.Copy F2.Cells
F1.UsedRange.Sort F1.Columns(1), Header:=xlYes 'tri
F2.UsedRange.Sort F2.Columns(1), Header:=xlYes 'tri
F.Rows("3:" & F.Rows.Count).Delete 'RAZ
F2.UsedRange.Offset(1).Copy F.[A3].Offset(, ncol)
t = F.UsedRange.Offset(1)
t1 = F1.UsedRange.Resize(, ncol): ub = UBound(t1)
t2 = F2.UsedRange.Resize(UBound(t))
ReDim a(1 To UBound(t), 1 To ncol)
ReDim doublon1(1 To UBound(t1), 1 To 1)
ReDim doublon2(1 To UBound(t2), 1 To 1)
deb = 2
For i = 2 To UBound(t)
  x = t(i, ncol + 1)
  If x <> t(i - 1, ncol + 1) Then 'évite les doublons
    For j = deb To ub
      If j < ub Then If t1(j + 1, 1) = t1(j, 1) Then _
        doublon1(j + 1, 1) = "Doublon"
      If x = t1(j, 1) Then
        For k = 1 To ncol
          a(i - 1, k) = t1(j, k)
        Next k
        t1(j, 1) = Empty
        t2(i, 1) = Empty
        deb = j + 1
        Exit For
      End If
    Next j
  Else
    doublon2(i, 1) = "Doublon"
  End If
Next i
F.[A3].Resize(i - 1, ncol) = a
F1.UsedRange.Resize(, ncol) = t1
F2.UsedRange = t2
With F1.UsedRange.Columns(1).Offset(, F1.UsedRange.Columns.Count)
  .Value = doublon1
  .Font.Bold = True 'gras
End With
With F2.UsedRange.Columns(1).Offset(, F2.UsedRange.Columns.Count)
  .Value = doublon2
  .Font.Bold = True 'gras
End With
'--suppression des cellules vides en colonne A---
F.UsedRange.Offset(1).Sort F.Columns(1), Header:=xlYes 'tri
F1.UsedRange.Sort F1.Columns(1), Header:=xlYes 'tri
F2.UsedRange.Sort F2.Columns(1), Header:=xlYes 'tri
On Error Resume Next
F.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
F1.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
F2.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
Fichier (3 bis).

A
 

Fichiers joints

job75

XLDnaute Barbatruc
Re : Extraire et comparer feuilles excel -macro

Re,

A la place des fichiers (3) et (3 bis) utilisez (4) et (4 bis) car c'est plus rapide avec :

Code:
F1.UsedRange.Columns(1) = t1
F2.UsedRange.Columns(1) = t2
puisque seule la colonne A est modifiée.

A+
 

Fichiers joints

job75

XLDnaute Barbatruc
Re : Extraire et comparer feuilles excel -macro

Re,

J'ai testé avec 11000 références sans doublon en "Source A" et les mêmes en "Source B".

Sur Win 8 - Excel 2013 :

- fichier Dranreb du post #9 => 3,54 secondes

- mon fichier (4) => 0,45 seconde

- mon fichier (4 bis) => 0,51 seconde.

Bonne fin de soirée.
 

Dranreb

XLDnaute Barbatruc
Re : Extraire et comparer feuilles excel -macro

Bonsoir.

Bon, c'est possible, après tout que ce soit parfois plus rapide avec des Sort pour de gros volumes de données.
Mais j'aime bien la simplicité d'utilisation de ma fonction GroupOrg et sa performance relativement bonne.
De toute façon on dirait que le(la) demandeur(deresse) fantôme se soit désintéressé(e) de sa demande.
 

fleur

XLDnaute Nouveau
Re : Extraire et comparer feuilles excel -macro

Bonjour Dranreb

Je te remercie pour cette optimisation du code VBA, j' n ' ai pa pu te répondre plus vite car mon PC est tombé en rade, j ' ai fait le test l' analyse est parfaite cela répond bien a mes attentes
 

fleur

XLDnaute Nouveau
Re : Extraire et comparer feuilles excel -macro

Bonjour Job 75


J ' ai tester aussi, c est impressionnant, ton code est bleuffant , merci pour ton aide- (désolé pour délai , PC est tobé en rade)
 

Discussions similaires


Haut Bas