Microsoft 365 Lier et remplacer 2 valeurs identiques dans 2 tableaux différents

KnewIT

XLDnaute Nouveau
Bonjour,
C'est mon premier post ici.

J’ai deux tableaux générés sur Excel par extraction de données d’un autre logiciel (l’extraction est faite par une macro VBA).
imgfr1.jpg

J’aimerais que les valeurs communes de chacun des tableaux soient liées de telle façon que si je change la valeur ABC02 dans le deuxième tableau par ABC03 par exemple alors la valeur ABC02 du premier tableau sera elle aussi remplacée par ABC03.
imgfr2.JPG

et vice versa (c’est-à-dire un changement du premier tableau provoquerait un changement du deuxième) et ceci pour chaque valeur de la colonne NOM du tableau.

J’ai essayé d’utiliser la valeur du Handle pour identifier les valeurs identiques des 2 tableaux avec le code suivant:

VB:
Sub Test1()
Dim i, y As Integer

For i = 10 To 11
    y = 7
    Do Until y = 5
        y = y - 1
        If Range("C" & y).Value = Range("C" & i).Value Then
            Range("D" & y).Value = Range("B" & i).Value
        End If
    Loop

'' Action :
Next i

End Sub

Ce qui donne ça:

imgfr3.jpg

Mais je ne sais pas comment le faire pour l’autre tableau de manière efficace (optimisée sans boucle for and do) afin d’obtenir ce résultat:
imgfr4.jpg

et comment continuer après ça (ou même si je dois faire ça !)

J’ai essayé d’expliquer mon problème clairement avec ces images mais si je peux clarifier quoi que ce soit, n’hésitez pas à me demander.

Merci
 

KnewIT

XLDnaute Nouveau
On m'a donné une réponse sur une autre forum (donc je la poste ici au cas où quelqu'un cherche à faire la même chose) :

VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim x As Variant
Application.EnableEvents = False
Set f2 = Sheets("Image")
If Not Intersect(Target, Columns(3)) Is Nothing Then
    If Range(Target.Address).Value <> f2.Range(Target.Address).Value Then
        TargetImage = f2.Range(Target.Address).Value
        With f2
            Set x = Columns(3).Find(TargetImage)
            If Not x Is Nothing Then
                Pos = x.Address
                Do
                    If x.Row <> Target.Row Then
                        Cells(x.Row, "C") = Target.Value
                        'Modification of the Image sheet
                        f2.Cells(x.Row, "C") = Target.Value
                        f2.Range(Target.Address).Value = Target.Value
                    Else
                        Set x = .FindNext(x)
                    End If
                Loop While Not x Is Nothing And x.Address <> Pos
            End If
        End With
    End If
End If
Set f2 = Nothing
Application.EnableEvents = True
End Sub

On suppose ici que :
  1. Il y a deux feuilles identiques et la deuxième s'appelle "Image"
  2. On n'utilise que la première feuille
  3. Les valeurs à remplacer se trouvent toutes les 2 dans la 3ème colonne
  4. Il n'y a pas de valeurs en double dans la 3ème colonne de chaque tableau
Si vous voulez exécuter une autre macro avant (comme moi avec mon extraction de données) il faut utiliser ce bout de code dans votre macro :

VB:
    On Error GoTo ErrHandler
    Application.EnableEvents = False

'Your code here...

ErrHandler:
   Application.EnableEvents = True

Si vous modifiez la macro Worksheet_Change et que vous obtenez une erreur, il faut corriger l'erreur et réaffecter la valeur True à la variable Application.EnableEvents avec la macro suivante par exemple :

VB:
Sub ReenableEventsApresBug()
Application.EnableEvents = True
End Sub
 

Discussions similaires