Macro de comparaison de deux cellules vs deux autres cellules

[lord_2009]

Bonjour tout le monde,
je viens demander de l'aide sur une petit truc que je voulais faire mais malheureusement impossible de réussir quelques choses dessus

voici le fichier la demande est dedans

je remercie pour votre aide d'avance,

Lord

 

[Robert]

Re : Macro de comparaison de deux cellules vs deux autres cellules

Bonsoir Lord, bonsoir le forum,

Pas sûr d'avoir bien compris, en pièce jointe ton fichier modifié avec le code ci-dessous :

Public Sub Macro1()
Dim O1 As Object 'déclare la variable O1 (Onglet 1)
Dim O2 As Object 'déclare la variable O2 (Onglet 2)
Dim DL As Long 'déclare la variable DL (Dernière Ligne)
Dim PL As Range 'déclare la variable PL (PLage)
Dim CEL As Range 'déclare la variable CEL (CELlule)
Dim R As Range 'déclare la variable R (Recherche)
Dim PA As String 'déclare la variable PA (Première Adresse)
Dim EC As Integer 'déclare la variable EC (ECart)
Dim test As Boolean 'déclare la variable test

Set O1 = Sheets("Feuil1") 'définit l'onglet O1
Set O2 = Sheets("Feuil2") 'définit l'onglet O2
DL = O1.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne 1 (=A) de l'onglet O1
Set PL = O1.Range("A2:A" & DL) 'définit la plage PL
For Each CEL In PL 'boucle sur toutes les cellule CEL de la plage PL
    test = False 'initialise la variable test
    'définit la recherche R (recherche la valeur de la cellule CEL dans la colonne 1 (=A) de l'onglet O2)
    Set R = O2.Columns(1).Find(CEL.Value, , xlValues, xlWhole)
    If Not R Is Nothing Then 'condition 1 : si il existe au moins une occurrence trouvée
        PA = R.Address 'définit l'adresse PA de la première occurrence trouvée
        Do 'exécute
            If R.Offset(0, 1).Value = CEL.Offset(0, 1).Value Then 'condition 2 : si les cellules correspondantes en colonne B sont égales
                EC = CInt(R.Offset(0, 2).Value) + CInt(CEL.Offset(0, 2).Value) 'définit l'écart EC
                test = True 'définit la variable test
                Exit Do 'sort de la boucle Do... Loop
            End If 'fin de la condition 2
            Set R = O2.Columns(1).FindNext(R) 'redéfinit la recherche R (occurrence suivante)
        Loop While Not R Is Nothing And R.Address <> PA 'boucle tant qu'il existe des occurrences ailleurs qu'en PA
    End If 'fin de la condition 1
    If test = False Then 'si test est "faux" (cela signifie qu'aucune occurence n'est trouvée avec type et numéro communs)
        'message
        MsgBox "Il n'y a aucune occurrence de type : " & CEL.Value & " et de numéro : " & CEL.Offset(0, 1).Value & " dans l'onglet : Feuil2 !"
        GoTo question 'va à l'étiquette "question"
    Else 'sinon (si test est "vrai")
        If EC < -20 Then 'condition 3 : si l'écart est inférieur à -20
            MsgBox "Erreur pour le type : " & CEL.Value & ", numéro : " & CEL.Offset(0, 1).Value _
               & ", car il y a un écart de : " & EC & " !" 'message
               GoTo question 'va à l'étiquette "question"
        End If 'fin de la condition 3
    End If 'fin de la condition 2
    GoTo inte 'va à l'étiquette "inte"
question:
    'condition 4 : si "non" au message
    If MsgBox("Etes-vous certain de vouloir intégrer?", vbYesNo, "Demande de confirmation") = vbNo Then
        'code pour "non" à l'intégration
        MsgBox "Je n'intègre pas !" 'à effacer...
    Else 'sinon (si "oui" au message)
inte:
        'code pour "oui" à l'intégration
        MsgBox "J'intègre !" 'à effacer...
    End If 'fin de la condition 4
Next CEL 'prochaine cellule de la boucle
End Sub

Le fichier :

 

[lord_2009]

Re : Macro de comparaison de deux cellules vs deux autres cellules

Bonsoir Robert
merci à toi pour ta macro

Cependant ce n'est pas totalement ce que je voulais, j'aurais voulu que tout les résultats s'affiche directement dans un seul message box et non plusieurs.
et que la demande d'intégration soit faite juste après le résumer des résultats en une seul fois comme elle était faite sur ma macro précédente.
Mais pour ce qui est des résultats c'est ce que je voulais donc merci beaucoup.

Voilà excuses moi pour mon manque de précision surtout que je vois que tu as fait une très belle macro qui a du te passer pas mal de temps.

Donc merci encore à toi si tu pouvais faire les modifications car je pense avoir un peu de mal à le faire malgré tout tes commentaires. Si jamais tu ne peux pas merci encore et j'essayerais de me débrouiller demain en modifiant un peu tout ^^

Et encore merci

 

[Robert]

Re : Macro de comparaison de deux cellules vs deux autres cellules

Bonjour Lord, bonjour le forum,

Peut-être comme ça :

Public Sub Macro1()
Dim O1 As Object 'déclare la variable O1 (Onglet 1)
Dim O2 As Object 'déclare la variable O2 (Onglet 2)
Dim DL As Long 'déclare la variable DL (Dernière Ligne)
Dim PL As Range 'déclare la variable PL (PLage)
Dim CEL As Range 'déclare la variable CEL (CELlule)
Dim R As Range 'déclare la variable R (Recherche)
Dim PA As String 'déclare la variable PA (Première Adresse)
Dim EC As Integer 'déclare la variable EC (ECart)
Dim test As Boolean 'déclare la variable test
Dim MSG As String 'déclare la variable MSG (MeSsaGe)

Set O1 = Sheets("Feuil1") 'définit l'onglet O1
Set O2 = Sheets("Feuil2") 'définit l'onglet O2
DL = O1.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne 1 (=A) de l'onglet O1
Set PL = O1.Range("A2:A" & DL) 'définit la plage PL
For Each CEL In PL 'boucle sur toutes les cellule CEL de la plage PL
    test = False 'initialise la variable test
    'définit la recherche R (recherche la valeur de la cellule CEL dans la colonne 1 (=A) de l'onglet O2)
    Set R = O2.Columns(1).Find(CEL.Value, , xlValues, xlWhole)
    If Not R Is Nothing Then 'condition 1 : si il existe au moins une occurrence trouvée
        PA = R.Address 'définit l'adresse PA de la première occurrence trouvée
        Do 'exécute
            If R.Offset(0, 1).Value = CEL.Offset(0, 1).Value Then 'condition 2 : si les cellules correspondantes en colonne B sont égales
                EC = CInt(R.Offset(0, 2).Value) + CInt(CEL.Offset(0, 2).Value) 'définit l'écart EC
                test = True 'définit la variable test
                Exit Do 'sort de la boucle Do... Loop
            End If 'fin de la condition 2
            Set R = O2.Columns(1).FindNext(R) 'redéfinit la recherche R (occurrence suivante)
        Loop While Not R Is Nothing And R.Address <> PA 'boucle tant qu'il existe des occurrences ailleurs qu'en PA
    End If 'fin de la condition 1
    If test = False Then 'si test est "faux" (cela signifie qu'aucune occurence n'est trouvée avec type et numéro communs)
        'message
        MSG = MSG & "Il n'y a aucune occurrence de type : " & CEL.Value & " et de numéro : " & CEL.Offset(0, 1).Value & " dans l'onglet : Feuil2 !" & Chr(10)
        'GoTo question 'va à l'étiquette "question"
    Else 'sinon (si test est "vrai")
        If EC < -20 Then 'condition 3 : si l'écart est inférieur à -20
            MSG = MSG & "Erreur pour le type : " & CEL.Value & ", numéro : " & CEL.Offset(0, 1).Value _
               & ", car il y a un écart de : " & EC & " !" & Chr(10) 'message
               GoTo question 'va à l'étiquette "question"
        End If 'fin de la condition 3
    End If 'fin de la condition 2
    'GoTo inte 'va à l'étiquette "inte"
question:
Next CEL 'prochaine cellule de la boucle
MsgBox MSG
'condition 4 : si "non" au message
If MsgBox("Etes-vous certain de vouloir intégrer?", vbYesNo, "Demande de confirmation") = vbNo Then
    'code de non intégration
Else 'sinon (si "oui" au message)
    'code d'intégration
End If 'fin de la condition 4
End Sub

Le Fichier :