EXCEL - VBA - Comparaison entre 2 feuilles (ajout et difference)

airsage

XLDnaute Junior
Bonjour à tous,

Dans le fichier excel ci joint, je voudrais faire 2 types de comparaisons sur 2 feuilles différentes :

Exemple 1 : J'ai une feuille "NEW" et une feuille "OLD". Je voudrais faire la comparaison entre les colonnes "Date de modification". Si les 2 dates sont identiques alors copier la ligne entière du ticket dans le feuille "DIFF"

Exemple 2 : J'ai une feuille "NEW" et une feuille "OLD". Je voudrais ajouter tous les tickets de la feuille "NEW" qui ne sont pas dans le feuille "OLD" et copier la ligne entière dans le feuille "AJOUT"

BONUS : dans ma macro, je note le début et la fin de la macro dans une msgbox mais je voudrais aussi que la date de fin apparaisse dans le feuille "DATE" en A1.

debuttrait = Now

<MA MACRO>

fintrait = Now

MsgBox "L'ensemble des traitements sont terminés." & vbCr & _
"Début : " & debuttrait & vbCr & _
"fin : " & fintrait

Merci par avance pour votre contribution
 

Pièces jointes

  • EXCEL - VBA - Comparaison entre 2 feuilles (ajout et difference).xlsx
    11 KB · Affichages: 75

Staple1600

XLDnaute Barbatruc
Re : EXCEL - VBA - Comparaison entre 2 feuilles (ajout et difference)

Re

Même en supprimant les doublons, j'obtiens le même résultatt en feuille DIFF
Exemple en feuille OLD, nous avons la date du 15/08/2013
Et sur la feuille NEW cette date apparait 5 cinq fois dans la colonne C
Donc nous retrouvons 5 fois cette date (et les données qui y sont rattachées) sur la feuille DIFF un fois la macro exécutée.
C'est ce qui était demandé, non ?
Si les 2 dates sont identiques alors copier la ligne entière du ticket dans le feuille "DIFF"

La macro modifiée pour supprimer les dates doublons dans OLD
Code:
Sub Add_DIFFBis()
Dim a As Worksheet, b As Worksheet, i&, dm As Range
Set a = Sheets("NEW")
Set b = Sheets("OLD")
Application.ScreenUpdating = False
b.Columns(3).Copy b.Columns(5)
b.Columns(5).RemoveDuplicates 1, xlYes
Set dm = b.Range(b.Cells(2, 5), b.Cells(Rows.Count, 5).End(3))
Sheets("DIFF").Range("A1:C1") = Array("Ticket", "Date ouverture", "Date modification")
For i = 2 To a.Cells(Rows.Count, 3).End(3).Row
If IsNumeric(Application.Match(a.Cells(i, 3), [dm], 0)) Then
Sheets("DIFF").Cells(Rows.Count, 1).End(3)(2).Resize(, 3).Value = a.Cells(i, 1).Resize(, 3).Value
End If
Next
b.Columns(5).Clear
End Sub
 

airsage

XLDnaute Junior
Re : EXCEL - VBA - Comparaison entre 2 feuilles (ajout et difference)

Re,

La macro que tu m'as fourni est bonne sauf quelle prend aussi en compte les tickets dans "NEW" qui ne sont plus dans "OLD".

Ci joint, le fichier modifié.
Dans la la feuille "DIFF" j'ai regroupé les tickets "NEW" et "OLD".
- En Orange les tickets quine sont plus plusdans "OLD", ces tickets ne doivent pas être prit en compte. peux t'on ajouter une exclusion dans la macro existante pour ne pas copier c'es tickets dans "DIFF".

Merci par avance.
 

Pièces jointes

  • EXCEL - VBA - Comparaison entre 2 feuilles modifié.xlsm
    19.6 KB · Affichages: 41

Staple1600

XLDnaute Barbatruc
Re : EXCEL - VBA - Comparaison entre 2 feuilles (ajout et difference)

Re

Pendant que tu faisais ta nouvelle PJ
Je faisais ceci
C'est pas encore cela?
Code:
Sub ADD_DIFF_ET_AJOUT()
Dim a As Worksheet, b As Worksheet, t, i&, dm As Range, ld&, dl&
t = Array("Ticket", "Date ouverture", "Date modification")
Set a = Sheets("NEW"): Set b = Sheets("OLD")
ld = a.Cells(Rows.Count, 3).End(3).Row
dl = b.Cells(Rows.Count, 3).End(3).Row
a.Range(a.Cells(2, 4), a.Cells(ld, 4)).FormulaR1C1 = "=RC[-3]&RC[-1]"
b.Range(b.Cells(2, 4), b.Cells(dl, 4)).FormulaR1C1 = "=RC[-3]&RC[-1]"
Set dm = b.Range(b.Cells(2, 4), b.Cells(Rows.Count, 4).End(3))
Application.ScreenUpdating = False
Sheets("DIFF").[A1:C1] = t: Sheets("AJOUT").[A1:C1] = t
For i = 2 To a.Cells(Rows.Count, 4).End(3).Row
If IsError(Application.Match(a.Cells(i, 4), [dm], 0)) Then
Sheets("AJOUT").Cells(Rows.Count, 1).End(3)(2).Resize(, 3).Value = a.Cells(i, 1).Resize(, 3).Value
ElseIf IsNumeric(Application.Match(a.Cells(i, 4), [dm], 0)) Then
Sheets("DIFF").Cells(Rows.Count, 1).End(3)(2).Resize(, 3).Value = a.Cells(i, 1).Resize(, 3).Value
End If
Next
a.Columns(4).Clear: b.Columns(4).Clear
End Sub
Je vais vérifier en allant voir ta dernière PJ
 

Discussions similaires

Réponses
2
Affichages
121