XL 2010 Comparaison automatisée

motine

XLDnaute Nouveau
Bonjour à tous,

Après avoir longtemps cherché dans les forums, j'ai récupéré des codes VBA pour des sujets similaires que j'ai essayés de modifier. En raison de mon très faible niveau, je n'ai pas réussi. Par conséquent, je sollicite votre aide, svp.

Pour mieux comprendre le fichier joint, je vous explique un peu :
Je fais fréquemment des extractions à 5 - 7 jours d'intervalle.
Chaque fichier extrait est enregistré sous un onglet, daté du jour et comportant 3 colonnes (Ordre - Quantité - Date)
Le nombre de colonnes est toujours identique.

Avec votre aide, svp, je souhaiterais :
- comparer ligne par ligne un fichier avec le précédent;
- afficher sur la colonne D du dernier fichier, le statut "ligne inchangée, ligne modifiée ou nouvelle ligne"
- dans le cas d'une ligne modifiée, mettre en couleur la cellule qui est différente.
- afficher dans la cellule E1 du dernier fichier, le rapport " nombre de lignes inchangées / nombre total de lignes" en pourcentage.
- automatiser cette tache afin que chaque nouveau fichier soit comparé au précédent.

Si je suis passé à coté de la solution déjà postée, je vous serais très reconnaissant de me la faire suivre.

Je vous remercie beaucoup et vous souhaite une excellente fin de journée

Motine
 

Pièces jointes

  • Comparaison automatisée.xlsm
    20.1 KB · Affichages: 12

Papou-net

XLDnaute Barbatruc
Re : Comparaison automatisée

Bonjour motine, et bienvenue sur XLD,

Ci-dessous ta macro "Comparaison" modifiée:

Code:
Sub Comparaison()
Dim Cel1 As Range, Cel2 As Range, Modif As Boolean
Dim F1 As Worksheet, F2 As Worksheet
Dim I As Integer
 
Set F1 = Sheets(Sheets.Count)
Set F2 = Sheets(Sheets.Count - 1)
Application.ScreenUpdating = False
With F1
  For Each Cel1 In .Range("A2:A" & Rows.Count).SpecialCells(xlCellTypeConstants)
    Set Cel2 = F2.Columns(1).Find(Cel1, LookIn:=xlValues, lookat:=xlWhole)
    If Cel2 Is Nothing Then
      Cel1.Offset(0, 3) = "Nouvelle ligne"
      Else
      Modif = False
      For I = 1 To 2
        If Cel1.Offset(0, I).Value <> Cel2.Offset(0, I) Then
          Modif = True
          Cel1.Offset(0, I).Font.ColorIndex = 3
          Else
          Cel1.Offset(0, I).Font.ColorIndex = 1
        End If
      Next
      Cel1.Offset(0, 3) = IIf(Modif = True, "Ligne modifiée", "Ligne inchangée")
    End If
  Next
  .Range("E1") = WorksheetFunction.CountIf(.Columns(4), "Ligne inchangée") / .Columns(4).SpecialCells(xlCellTypeConstants).Count
End With
Application.ScreenUpdating = True
End Sub
Sur la copie en PJ, j'ai laissé la feuille brute d'extraction. Un clic sur le bouton Démo simule la mise au format souhaitée.

Les feuilles F1 et F2 seront adaptées automatiquement lors de chaque nouvelle extraction. Il sera donc inutile de modifier le code.

A +

Cordialement.
 

Pièces jointes

  • Copie de Comparaison automatisée.xlsm
    23 KB · Affichages: 15

motine

XLDnaute Nouveau
Re : Comparaison automatisée

Bonjour Papou-net, bonjour à tous.

Merci beaucoup, c'est superbe.

Concernant cette dernière ligne, désolé de ne pas y avoir pensé plus tôt :
.Range("E1") = WorksheetFunction.CountIf(.Columns(4), "Ligne inchangée") / .Columns(4).SpecialCells(xlCellTypeConstants).Count

Comment la modifier pour que le pourcentage ne se calcule que sur la période (date) commune aux 2 dernières feuilles, automatiquement ?
Dans mon exemple, l'avant-dernière feuille couvre la période du 21/04 au 30/04 et la dernière du 27/04 au 08/05
Quel code écrire pour que ce pourcentage ne se calcule que pour la période commune aux deux feuilles, en l'occurrence du 27/04 au 30/04 ?

Encore merci et bonne journée.

Motine
 

Papou-net

XLDnaute Barbatruc
Re : Comparaison automatisée

Bonjour motine,

Je te laisse le soin vérifier, sur la copie en PJ, si le résultat correspond à tes attentes.

A +

Cordialement.
 

Pièces jointes

  • Copie 01 de Comparaison automatisée.xlsm
    26.1 KB · Affichages: 25