Comparer

Bonjour,

J'aimerai écrire un macro qui compare les résultats "total journalier" sur deux feuilles

Je m'explique j'ai un fichier excel qui contient les statistiques journalier donc on a le cumul qui est total journalier(Comme indiquer dans le fichier joint)

En gros je veux qu'il prennent le total journalier de la feuille 1 et qu'il la compare avec celle de la feuille 2 tous les colonne donc normalement il doit vérifier tous les colonnes de la ligne:

  • Si tous les résultats sont les mêmes c’est bon
  • Si les résultats ne sont pas conforme qu'il signalent a quel ligne les résultats ne sont pas conforme
  • Pour l’instant les deux feuilles contiennent les mêmes donnée mais vous pouviez modifier les résultats pour vérifier si ça marche
Si vous comprenez pas je vous réexplique

Merciii

8test-copie.xlsx (22.34 Ko)

Bonjour Doudou9003,le forum,

En gros je veux qu'il prennent le total journalier de la feuille 1 et qu'il la compare avec celle de la feuille 2 tous les colonne donc normalement il doit vérifier tous les colonnes de la ligne

Un essai......

Sub test()

  Dim i As Integer, j As Integer
  Dim msg As String, msg2 As String, msg3 As String

i = 22

  Set ws1 = Sheets("Feuil1")
  Set ws2 = Sheets("Feuil2")

  Application.ScreenUpdating = False

 For j = 2 To 18
  If ws1.Cells(i, j) <> ws2.Cells(i, j) Then msg = msg & "différence" & Cells(i, j).Address & "." & Chr(10)
  If ws1.Cells(i + 12, j) <> ws2.Cells(i + 12, j) Then msg2 = msg2 & "différence" & Cells(i + 12, j).Address & "." & Chr(10)
  If ws1.Cells(i + 24, j) <> ws2.Cells(i + 24, j) Then msg3 = msg3 & "différence" & Cells(i + 24, j).Address & "." & Chr(10)

 Next j

 MsgBox msg & msg2 & msg3

End Sub
8test.xlsm (31.74 Ko)

Cordialement,

Bonjour Doudou9003,le forum,

En gros je veux qu'il prennent le total journalier de la feuille 1 et qu'il la compare avec celle de la feuille 2 tous les colonne donc normalement il doit vérifier tous les colonnes de la ligne

Un essai......

Sub test()

  Dim i As Integer, j As Integer
  Dim msg As String, msg2 As String, msg3 As String

i = 22

  Set ws1 = Sheets("Feuil1")
  Set ws2 = Sheets("Feuil2")

  Application.ScreenUpdating = False

 For j = 2 To 18
  If ws1.Cells(i, j) <> ws2.Cells(i, j) Then msg = msg & "différence" & Cells(i, j).Address & "." & Chr(10)
  If ws1.Cells(i + 12, j) <> ws2.Cells(i + 12, j) Then msg2 = msg2 & "différence" & Cells(i + 12, j).Address & "." & Chr(10)
  If ws1.Cells(i + 24, j) <> ws2.Cells(i + 24, j) Then msg3 = msg3 & "différence" & Cells(i + 24, j).Address & "." & Chr(10)

 Next j

 MsgBox msg & msg2 & msg3

End Sub

Test .xlsm

Cordialement,

Merci je vais l'essayer et pour inserrer un msgbox quand tout est correct

Re,

pour inserrer un msgbox quand tout est correct

Actuellement, si tout est OK, la msgbox reste vide.....

Je me suis rendu compte que je ne répondais pas entièrement à ta demande...en effet je ne t'indique que les cellules où le résultat est différent...

Voici une modif qui colore en jaunes les cellules concernées, (la msgbox ne concerne toujours, que les cellules total journalier).

Sub test()

  Dim i As Integer, j As Integer
  Dim msg As String, msg2 As String, msg3 As String

  Set ws1 = Sheets("Feuil1")
  Set ws2 = Sheets("Feuil2")

  Application.ScreenUpdating = False

 For j = 2 To 18
     i = 22
  If ws1.Cells(i, j) <> ws2.Cells(i, j) Then msg = msg & "différence" & Cells(i, j).Address & "." & Chr(10)
  If ws1.Cells(i + 12, j) <> ws2.Cells(i + 12, j) Then msg2 = msg2 & "différence" & Cells(i + 12, j).Address & "." & Chr(10)
  If ws1.Cells(i + 24, j) <> ws2.Cells(i + 24, j) Then msg3 = msg3 & "différence" & Cells(i + 24, j).Address & "." & Chr(10)

 For i = 13 To 21
   If ws1.Cells(i, j) <> ws2.Cells(i, j) Then
      ws1.Cells(i, j).Interior.ColorIndex = 6                 'couleur jaune si cellules différentes entre les 2 feuilles
      ws2.Cells(i, j).Interior.ColorIndex = 6
   Else
      ws1.Cells(i, j).Interior.ColorIndex = xlNone            'pas de couleur si cellules égales dans les 2 feuilles
      ws2.Cells(i, j).Interior.ColorIndex = xlNone
   End If

   If ws1.Cells(i + 12, j) <> ws2.Cells(i + 12, j) Then
      ws1.Cells(i + 12, j).Interior.ColorIndex = 6
      ws2.Cells(i + 12, j).Interior.ColorIndex = 6
   Else
      ws1.Cells(i + 12, j).Interior.ColorIndex = xlNone
      ws2.Cells(i + 12, j).Interior.ColorIndex = xlNone
   End If

   If ws1.Cells(i + 24, j) <> ws2.Cells(i + 24, j) Then
      ws1.Cells(i + 24, j).Interior.ColorIndex = 6
      ws2.Cells(i + 24, j).Interior.ColorIndex = 6
   Else
      ws1.Cells(i + 24, j).Interior.ColorIndex = xlNone
      ws2.Cells(i + 24, j).Interior.ColorIndex = xlNone
   End If
  Next i
 Next j

 MsgBox msg & msg2 & msg3                'message vide si tout est OK

End Sub
5test-1.xlsm (32.82 Ko)

Il y a certainement moyen de simplifier où même de faire mieux mais je n'ai plus le temps....préparation du réveillon !

Bon réveillon !

Re,

pour inserrer un msgbox quand tout est correct

Actuellement, si tout est OK, la msgbox reste vide.....

Je me suis rendu compte que je ne répondais pas entièrement à ta demande...en effet je ne t'indique que les cellules où le résultat est différent...

Voici une modif qui colore en jaunes les cellules concernées, (la msgbox ne concerne toujours, que les cellules résultats).

Sub test()

  Dim i As Integer, j As Integer
  Dim msg As String, msg2 As String, msg3 As String

  Set ws1 = Sheets("Feuil1")
  Set ws2 = Sheets("Feuil2")

  Application.ScreenUpdating = False

 For j = 2 To 18
     i = 22
  If ws1.Cells(i, j) <> ws2.Cells(i, j) Then msg = msg & "différence" & Cells(i, j).Address & "." & Chr(10)
  If ws1.Cells(i + 12, j) <> ws2.Cells(i + 12, j) Then msg2 = msg2 & "différence" & Cells(i + 12, j).Address & "." & Chr(10)
  If ws1.Cells(i + 24, j) <> ws2.Cells(i + 24, j) Then msg3 = msg3 & "différence" & Cells(i + 24, j).Address & "." & Chr(10)

 For i = 13 To 21
   If ws1.Cells(i, j) <> ws2.Cells(i, j) Then
      ws1.Cells(i, j).Interior.ColorIndex = 6                 'couleur jaune si cellules différentes entre les 2 feuilles
      ws2.Cells(i, j).Interior.ColorIndex = 6
   Else
      ws1.Cells(i, j).Interior.ColorIndex = xlNone            'pas de couleur si cellules égales dans les 2 feuilles
      ws2.Cells(i, j).Interior.ColorIndex = xlNone
   End If

   If ws1.Cells(i + 12, j) <> ws2.Cells(i + 12, j) Then
      ws1.Cells(i + 12, j).Interior.ColorIndex = 6
      ws2.Cells(i + 12, j).Interior.ColorIndex = 6
   Else
      ws1.Cells(i + 12, j).Interior.ColorIndex = xlNone
      ws2.Cells(i + 12, j).Interior.ColorIndex = xlNone
   End If

   If ws1.Cells(i + 24, j) <> ws2.Cells(i + 24, j) Then
      ws1.Cells(i + 24, j).Interior.ColorIndex = 6
      ws2.Cells(i + 24, j).Interior.ColorIndex = 6
   Else
      ws1.Cells(i + 24, j).Interior.ColorIndex = xlNone
      ws2.Cells(i + 24, j).Interior.ColorIndex = xlNone
   End If
  Next i
 Next j

 MsgBox msg & msg2 & msg3                'message vide si tout est OK

End Sub

Test -1.xlsm

Il y a certainement moyen de simplifier où même de faire mieux mais je n'ai plus le temps....préparation du réveillon !

Bon réveillon !

Super ça marche merci par contre tu peux m’expliquer un peux le code les 12 22 24 et autre j'ai du mal a comprendre

Merci

Bon réveillon!

Re,

tu peux m’expliquer un peux le code les 12 22 24 et autre j'ai du mal a comprendre

For j = 2 To 18
     i = 22
  If ws1.Cells(i, j) <> ws2.Cells(i, j) Then msg = msg & "différence" & Cells(i, j).Address & "." & Chr(10)
  If ws1.Cells(i + 12, j) <> ws2.Cells(i + 12, j) Then msg2 = msg2 & "différence" & Cells(i + 12, j).Address & "." & Chr(10)
  If ws1.Cells(i + 24, j) <> ws2.Cells(i + 24, j) Then msg3 = msg3 & "différence" & Cells(i + 24, j).Address & "." & Chr(10)

Ce code concerne uniquement les lignes "Total" soit 22, 34, et 46.

J'ai donc mon i qui est égal à 22 pour la première ligne, il est ensuite égal à 34 (soit i +12) puis 46 (i+12+12 soit i+24).

J'aurai dû faire ainsi:

For j = 2 To 18
  For y = 22 To 48 Step 12
  If ws1.Cells(y, j) <> ws2.Cells(y, j) Then msg = msg & "différence" & Cells(y, j).Address & "." & Chr(10)
 Next y
7test-2.xlsm (32.79 Ko)
For i = 13 To 21
   If ws1.Cells(i, j) <> ws2.Cells(i, j) Then
      ws1.Cells(i, j).Interior.ColorIndex = 6                 'couleur jaune si cellules différentes entre les 2 feuilles
      ws2.Cells(i, j).Interior.ColorIndex = 6
   Else
      ws1.Cells(i, j).Interior.ColorIndex = xlNone            'pas de couleur si cellules égales dans les 2 feuilles
      ws2.Cells(i, j).Interior.ColorIndex = xlNone
   End If

   If ws1.Cells(i + 12, j) <> ws2.Cells(i + 12, j) Then
      ws1.Cells(i + 12, j).Interior.ColorIndex = 6
      ws2.Cells(i + 12, j).Interior.ColorIndex = 6
   Else
      ws1.Cells(i + 12, j).Interior.ColorIndex = xlNone
      ws2.Cells(i + 12, j).Interior.ColorIndex = xlNone
   End If

   If ws1.Cells(i + 24, j) <> ws2.Cells(i + 24, j) Then
      ws1.Cells(i + 24, j).Interior.ColorIndex = 6
      ws2.Cells(i + 24, j).Interior.ColorIndex = 6
   Else
      ws1.Cells(i + 24, j).Interior.ColorIndex = xlNone
      ws2.Cells(i + 24, j).Interior.ColorIndex = xlNone
   End If
  Next i
 Next j

Pour la coloration des cellules si différentes:

Première plage de la ligne 13 à la ligne 21 (for i = 13 to 21), seconde plage de la ligne 25 à 33 (donc i+12) puis troisième de 37 à 45 (donc i+24)....je regarderai si je peux faire plus simple....

Mais comme je te l'ai dit, c'est un premier jet, il y a surement possibilité d'optimiser,

A l'année prochaine,

Re,

tu peux m’expliquer un peux le code les 12 22 24 et autre j'ai du mal a comprendre

For j = 2 To 18
     i = 22
  If ws1.Cells(i, j) <> ws2.Cells(i, j) Then msg = msg & "différence" & Cells(i, j).Address & "." & Chr(10)
  If ws1.Cells(i + 12, j) <> ws2.Cells(i + 12, j) Then msg2 = msg2 & "différence" & Cells(i + 12, j).Address & "." & Chr(10)
  If ws1.Cells(i + 24, j) <> ws2.Cells(i + 24, j) Then msg3 = msg3 & "différence" & Cells(i + 24, j).Address & "." & Chr(10)

Ce code concerne uniquement les lignes "Total" soit 22, 34, et 46.

J'ai donc mon i qui est égal à 22 pour la première ligne, il est ensuite égal à 34 (soit i +12) puis 46 (i+12+12 soit i+24).

J'aurai dû faire ainsi:

For j = 2 To 18
  For y = 22 To 48 Step 12
  If ws1.Cells(y, j) <> ws2.Cells(y, j) Then msg = msg & "différence" & Cells(y, j).Address & "." & Chr(10)
 Next y

Test -2.xlsm

For i = 13 To 21
   If ws1.Cells(i, j) <> ws2.Cells(i, j) Then
      ws1.Cells(i, j).Interior.ColorIndex = 6                 'couleur jaune si cellules différentes entre les 2 feuilles
      ws2.Cells(i, j).Interior.ColorIndex = 6
   Else
      ws1.Cells(i, j).Interior.ColorIndex = xlNone            'pas de couleur si cellules égales dans les 2 feuilles
      ws2.Cells(i, j).Interior.ColorIndex = xlNone
   End If

   If ws1.Cells(i + 12, j) <> ws2.Cells(i + 12, j) Then
      ws1.Cells(i + 12, j).Interior.ColorIndex = 6
      ws2.Cells(i + 12, j).Interior.ColorIndex = 6
   Else
      ws1.Cells(i + 12, j).Interior.ColorIndex = xlNone
      ws2.Cells(i + 12, j).Interior.ColorIndex = xlNone
   End If

   If ws1.Cells(i + 24, j) <> ws2.Cells(i + 24, j) Then
      ws1.Cells(i + 24, j).Interior.ColorIndex = 6
      ws2.Cells(i + 24, j).Interior.ColorIndex = 6
   Else
      ws1.Cells(i + 24, j).Interior.ColorIndex = xlNone
      ws2.Cells(i + 24, j).Interior.ColorIndex = xlNone
   End If
  Next i
 Next j

Pour la coloration des cellules si différentes:

Première plage de la ligne 13 à la ligne 21 (for i = 13 to 21), seconde plage de la ligne 25 à 33 (donc i+12) puis troisième de 37 à 45 (donc i+24)....je regarderai si je peux faire plus simple....

Mais comme je te l'ai dit, c'est un premier jet, il y a surement possibilité d'optimiser,

A l'année prochaine,

Merci a toi j’espère que quand tu aura le temps on se reverra ici pour optimiser le code. d'ici là heureuse année

A l’année prochaine.

Merci

Bonjour Doudou9003, le forum,

Un nouvel essai:

J'ai finalement opté pour une mfc pour la couleur des cellules si différentes.

A chaque modification sur l'une des feuilles, les cellules se colore en jaune si différence, sinon rien.

Est-utile de conserver la macro qui affiche la msgbox ?

9test-2.xlsm (32.86 Ko)

Une variante avec macro "msgbox" lié à l'évènement Change des feuilles (à chaque modification sur l'une des feuilles, un message indique la cellule résultat qui diffère de l'autre feuille, si tout est ok: message vierge).

7test-3.xlsm (34.79 Ko)

Bonne et heureuse année 2019 !

Bonjour Doudou9003, le forum,

Un nouvel essai:

J'ai finalement opté pour une mfc pour la couleur des cellules si différentes.

A chaque modification sur l'une des feuilles, les cellules se colore en jaune si différence, sinon rien.

Est-utile de conserver la macro qui affiche la msgbox ?

Test -2.xlsm

Une variante avec macro "msgbox" lié à l'évènement Change des feuilles (à chaque modification sur l'une des feuilles, un message indique la cellule résultat qui diffère de l'autre feuille, si tout est ok: message vierge).

Test -3.xlsm

Bonne et heureuse année 2019 !

Bonjour

Mes meilleurs vœux ! J’ai ressayer le fichier(Test -3.xlsm) il marche super bien par contre les couleur j’ai pas compris comment tu les a gérer je veux dire dans le code j’ai pas vu une parti qui les mentionnes(Text -3.xlsm) du genre si je voudrai changer la couleur ou autre chose Merci

Bonne et heureuse année!

Bonjour et bonne année 2019 !

Je te réponds de mon téléphone, n'étant pas chez moi actuellement.

Les couleurs sont gérées par "mfc" (1 par feuille).

Mise en forme conditinnelle/gérer les règles.

Tu verras alors la formule appliquée et la plage sur laquelle elle s'applique.

Cordialement.

Bonjour et bonne année 2019 !

Je te réponds de mon téléphone, n'étant pas chez moi actuellement.

Les couleurs sont gérées par "mfc" (1 par feuille).

Mise en forme conditinnelle/gérer les règles.

Tu verras alors la formule appliquée et la plage sur laquelle elle s'applique.

Cordialement.

D'accord merci frère c'est parfait.

Je vais encore te déranger supposons que au lieux de vérifier les résultats sur la feuil 1 et la feuille 2 j'aimerai qu'ils vérifie les totaux de la feuille 2 dans un autre fichier excel mais avec les même disposition au niveau des données(Je veux dire les totaux sont toujours sur les mêmes lignes) que la feuil1

Merci

Bonjour et bonne année 2019 !

Je te réponds de mon téléphone, n'étant pas chez moi actuellement.

Les couleurs sont gérées par "mfc" (1 par feuille).

Mise en forme conditinnelle/gérer les règles.

Tu verras alors la formule appliquée et la plage sur laquelle elle s'applique.

Cordialement.

Salut cher amis j’aimerai pousser un peu plus mon fichier excel , Pour cette fois j'aimerai qu'il compare les données d'un autre fichier a celle de la feuil2 au lieu de la feuil1 mais ce serai les mêmes donnée ce sera seulement la localisation qui change

Je m’explique un peu au lieu de comparer les lignes total de la feuil1 a celle de la feuil2 les données de la feuil1 doit être dans un autre fichier ficher excel et on récupère les lignes total et les comparer avec la ligne2(les donnes original se trouvent dans la feuil1 mais cette fois dans un autre fichier)

PS: Je veux éviter d'envoyer le fichier original avec VBA

J’espère l’idée est claire on aura juste qu'à dupliquer le fichier et s'en servir

Merci!

Rechercher des sujets similaires à "comparer"