Comparer une plage de cellule à elle même

Bonjour à tous,

Pour éviter d'exécuter un code VBA à chaque fois, je devrais comparer une plage à elle même.

Pour ce faire, il faut créer une capture de cette plage pour s'y référer dans la comparaison.

'-----

Si changement dans la plage alors créer un nouveau modèle

Sinon recopier le modèle existant

'------

Merci d’avance.

Bonjour

Pourquoi ne pas utiliser l'événement Change sur ta zone ?

Bonjour banzai64,

Pourquoi ne pas utiliser l'événement Change sur ta zone ?

Je ne le connais pas

Bonjour

Exemple : La plage contrôlée G6:K11

Code à placer dans le module de la feuille

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Range("G6:K11"), Target) Is Nothing And Target.Count = 1 Then
    MsgBox "Modification sur la zone surveillée"
    ' Appel de la macro
  End If
End Sub

Bonsoir,

Mon tableau à vérifier se trouve dans la feuille Feuil2.

Mon code est lancé depuis la feuille Feuil1.

Ce que je voulais dire c'est toujours vérifier si la plage "Feuil2!G6:K11" à été préserver par apport à son image créé pour la première fois dés l'ouverture du classeur par exemple.

J'espère avoir éclairci un petit peu le problème

Bonjour

apt a écrit :

J'espère avoir éclairci un petit peu le problème

Pas du tout

Comment est modifié la plage ?

Si c'est par des formules , par une modification manuelle ou par macro ?

A l'ouverture tu peux faire une copie de ta zone

et ensuite si tu veux tu peux intercepter un événement (Change,activate -ce sont les plus usités) et vérifier si il a des changements

Mais avec le peu de renseignements que tu donnes pas évident d'avoir une solution

Fournis un fichier reflétant ton fichier réel et explique quand tu veux que la vérification se fasse

Bonsoir,

La modification se fera manuellement sur le tableau en question.

un exemple en PJ.

Bonjour

Ça a l'air compliqué mais cela fonctionne

Sub Test_Tableau()
Dim Cel As Range

  For Each Cel In [SBrgd]
    If Cel <> [SBrgd_Capture].Cells(Cel.Row - [SBrgd].Row + 1, Cel.Column - [SBrgd].Column + 1) Then Exit For
  Next Cel
  If Not Cel Is Nothing Then
    MsgBox "La plage SBrgd a été modifiée" & vbCrLf & _
        "Création d'un nouveau modèle"
  Else
    MsgBox "Plages identiques, pas de changement !" & vbCrLf & _
        "Utilisation du modèle existant"
  End If
End Sub

Bonjour Banzai64,

Je voulais alléger le code avec ceci, mais ça ne marche pas :

Sub Test_Tableau()
    If Range("SBrgd").Value = Range("SBrgd_Capture").Value Then
        MsgBox "Plages identiques, pas de changement !" & vbCrLf & _
               "Utilisation du modèle existant"
    Else
        MsgBox "La plage SBrgd a été modifiée" & vbCrLf & _
               "Création d'un nouveau modèle"
        'Faire une copie du tableau pour la prochaine comparaison
        Range("M1").Resize(Range("Sbrgd_Capture").Rows.Count, 3).Value = Range("SBrgd")
    End If
End Sub

Bonjour

Ton code je l'avais déjà testé et comme j'avais vu qu'il ne fonctionnait pas je ne te l'avais pas proposé

Bonjour,

à tester :

dim pl1 as range, pl2 as range

set pl1 = Range("SBrgd")

set pl2 = Range("SBrgd_Capture")

if pl1=pl2 then

eric

edit:

Dans le doute j'ai quand même testé, ce n'est pas bon. Désolé.

Pour l'instant à part boucler sur toutes les cellules je ne vois rien d'autre.

Bonjour Banzai64, eriiic,

Banzai64 :: Je voulais testé un code pour le cas d'une grande plage. Pas réussi

eriiic :: Merci le test...

Bonjour

Je serais curieux de voir ce test sur un grand tableau

Fournis un fichier avec l'erreur

Merci

Bonjour Banzai64,

Je voulais testé un code pour le cas d'une grande plage. Pas réussi

Je voulais dire mon code à moi en remplacement de ton code :

Sub Test_Tableau()
        If Range("SBrgd").Value = Range("SBrgd_Capture").Value Then
            MsgBox "Plages identiques, pas de changement !" & vbCrLf & _
                   "Utilisation du modèle existant"
        Else
            MsgBox "La plage SBrgd a été modifiée" & vbCrLf & _
                   "Création d'un nouveau modèle"
            'Faire une copie du tableau pour la prochaine comparaison
           Range("M1").Resize(Range("Sbrgd_Capture").Rows.Count, 3).Value = Range("SBrgd")
        End If
    End Sub

J’espérais gagner en lignes de code et vitesse d’exécution

Bonjour,

J'ai trouvé un code que j'ai essayé d'adpter, sans succés (test_dif est toujours égal à TRUE) :

'---------------
Sub Test_Tableau()

    Dim arg1 As String, arg2 As String
    Dim test_dif As Boolean

    arg1 = Range("SBrgd").Worksheet.Name & "!" & Range("SBrgd").Address
    arg2 = Range("SBrgd_Capture").Worksheet.Name & "!" & Range("SBrgd_Capture").Address

    If (test_dif = Evaluate("=And(" & arg1 & "=" & arg2 & ")")) Then
        'test_dif = True
        'statements
        MsgBox "Plages identiques, pas de changement !" & vbCrLf & _
               "Utilisation du modèle existant"
    Else
        'test_dif = False
        'statements
        MsgBox "La plage SBrgd a été modifiée" & vbCrLf & _
               "Création d'un nouveau modèle"
        'Faire une copie du tableau pour la prochaine comparaison
        'Range("M1").Resize(Range("Sbrgd_Capture").Rows.Count, 3).Value = Range("SBrgd")
    End If

End Sub
'--------------

Bonjour

As-tu fais des tests sur la macro proposée ?

Si oui cela serait intéressant de connaitre les résultats

Bonjour Banzai64,

Banzai64 a écrit :

As-tu fais des tests sur la macro proposée ?

apt a écrit :

J'ai trouvé un code que j'ai essayé d'adpter, sans succés (test_dif est toujours égal à TRUE)

Bonjour le forum,

Pour que le code précédent fonctionne convenablement, il faut ajouter cette ligne en début :

test_dif = True

Le code complet :

Sub Test_Tableau1()

    Dim test_dif As Boolean, arg1 As String, arg2 As String

    'test de différence TRUE par défaut
    'Pour la première fois
    test_dif = True

    arg1 = Range("SBrgd").Worksheet.Name & "!" & Range("SBrgd").Address
    arg2 = Range("SBrgd_Capture").Worksheet.Name & "!" & Range("SBrgd_Capture").Address

    MsgBox "arg1 : " & arg1 & vbCrLf & _
           "arg2 : " & arg2
    If (test_dif = Evaluate("=And(" & arg1 & "=" & arg2 & ")")) Then
        'test_dif = True
        'statements
        MsgBox "Plages identiques, pas de changement !" & vbCrLf & _
               "Utilisation du modèle existant"
    Else
        'test_dif = False
        'statements
        MsgBox "La plage SBrgd a été modifiée" & vbCrLf & _
               "Création d'un nouveau modèle"
        'Faire une copie du tableau pour la prochaine comparaison
        With Sheets("Feuil2")
            .Range("M8").Resize(Range("Sbrgd").Rows.Count, 3).Value = Range("SBrgd").Value
        End With
    End If

End Sub

J'ai creusé du coté des formules, et j'ai pu coder cette deuxième solution, qui repose sur une formule matricielle :

Sub Test_Tableau2()
    Range("F2").FormulaArray = "=(SBrgd=SBrgd_Capture)"

    If [F2] = "Vrai" Then
        MsgBox "Plages identiques, pas de changement !" & vbCrLf & _
               "Utilisation du modèle existant"

    Else
        MsgBox "La plage SBrgd a été modifiée" & vbCrLf & _
               "Création d'un nouveau modèle"

        'Faire une copie du tableau pour la prochaine comparaison
        With Sheets("Feuil2")
            .Range("M8").Resize(Range("Sbrgd").Rows.Count, 3).Value = Range("SBrgd").Value
        End With
    End If
End Sub

L'exemple avec les deux solutions en pièce jointe.

Merci.