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
Merciii
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
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
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
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 ?
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).
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!