vba comparaison entre 2 colonnes

[scalaze62]

Bonjour,

Dans une feuil Excel ,j ai un tableau avec 2 colonnes

Colonne A de A2 à A800 mes références produits.
Colonne B de B2 à B800 les références qui seront ajouté aléatoirement

Chaque référence est unique ,il ne peut y avoir de doublon .

Je cherche à faire en VBA
si en colonne B la référence est présente en A on colorie la cellule A en vert
si en colonne B la référence a déjà été trouver msgbox " doublon"
si en colonne B la référence n est pas présente en colonne A alors message " référence non attendu"

Merci d avance pour votre aide.
Cordialement

 

[drul]

Salut, toujours d'actu ?
As-tu déjà tenté quelque chose ?

 

[scalaze62]

Bonsoir drul

oui toujours d actu

Voici ce que j'ai fait pour le moment mais qui comporte des erreurs avec le Else

 Private Sub Worksheet_Change(ByVal Target As Excel.Range)

Dim Lg%, x%
Lg = Range("d65536").End(xlUp).Row
lg1 = Range("b65536").End(xlUp).Row
    If Not Application.Intersect(Target, Range("d4:d" & Lg)) Is Nothing Then
            If Application.CountIf(Range("d:d"), Target) > 1 Then
                    x = Application.Match(Target, Range("d:d"), 0)
                If x = Target.Row Then
                    x = Application.Match(Target, Range(Target.Offset(1, 0), Cells(Lg, 1)), 0) + Target.Row
                                       
                End If
                    MsgBox ("DOUBLON !!!!!" & Chr(10) & "ligne " & x)
                    'Cells(x, 1).Select
                    Target.ClearContents
                    Exit Sub
                                                   
                                                                                 
                     Else
                        MsgBox ("L'EAN bippé n'est pasprésent dans la base de données !")
                      
                      End If

    End If
End Sub

avec le fichier c est plus visible

Edit modo: pas de fichier potentiellement infecté ici, désolé

 

[drul]

Salut,
Je republie ici ta macro remise en forme pour la lisibilité avec un ou deux commentaire auxquelles je te demande de répondre:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
 
Dim Lg%, x%
Lg = Range("d65536").End(xlUp).Row ' colonne d ? tu parles de A et B dans ton explication ...
lg1 = Range("b65536").End(xlUp).Row ' tu n'utilises jamais cette colonne, à quoi sert-elle ?

If Not Application.Intersect(Target, Range("d4:d" & Lg)) Is Nothing Then 'bien pensé ça !
    If Application.CountIf(Range("d:d"), Target) > 1 Then
        
       'kesako, quel est le but de x ??? tu n'en fais rien
        x = Application.Match(Target, Range("d:d"), 0)
        If x = Target.Row Then
            x = Application.Match(Target, Range(Target.Offset(1, 0), Cells(Lg, 1)), 0) + Target.Row

        End If
        MsgBox ("DOUBLON !!!!!" & Chr(10) & "ligne " & x)
        'Cells(x, 1).Select
        Target.ClearContents
        Exit Sub


    Else
        ' Tu ne regarde jamais dans la base de donnée ... mais seulement en colonne d ...
        MsgBox ("L'EAN bippé n'est pasprésent dans la base de données !")
    End If

End If
End Sub

De manière générale fais une description précise avec les bons numéro de colonne stp.
P.S. un printscreen à la place du fichier serait apprécié ...

 

[scalaze62]

Bonsoir drul

Le code mis est celui de mon premier projet sur 3 colonnes, mais après réflexion ,je suis partie sur 2 colonnes de contrôle pour une meilleur visibilité.

donc pour 2 colonnes :

si en colonne B la référence est présente en A on colorie la cellule A en vert ]OK

si en colonne B la référence a déjà été trouver msgbox " doublon" OK

si en colonne B la référence n est pas présente en colonne A alors message " référence non attendu"
KO

Je n'arrive pas à mettre une MSGBOX " référence non attendu" avant l effacement

code :

[code] Public DOUBLON As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)

If DOUBLON Then Exit Sub
    If Not Application.Intersect(Target, Columns("C")) Is Nothing Then
        If Target.Count > 1 Then Exit Sub
        If Application.CountIf(Range("C:C"), Target) > 1 Then
            DOUBLON = True
            MsgBox ("Attention DOUBLON" & Chr(10) & "Ce code existe déjà !" & Chr(10) & _
                "Il sera auomatiquement supprimé")
                Target.ClearContents
            DOUBLON = False
        End If
    End If
    
    a = Range("B4:B" & [B65000].End(xlUp).Row)
        Set MonDico1 = CreateObject("Scripting.Dictionary")
        On Error Resume Next
            For Each c In a: MonDico1.Add c, c: Next c
            
    b = Range("C4:C" & [C65000].End(xlUp).Row)
        Set MonDico2 = CreateObject("Scripting.Dictionary")
            For Each c In b
            If MonDico1.Exists(c) Then If Not MonDico2.Exists(c) Then MonDico2.Add c, c
            Next c

       Msgbox " référence non attendu"   ' apparaît a chaque valeur renseigner en C

     [C4:C65000].ClearContents 
    [C4].Resize(MonDico2.Count, 1) = Application.Transpose(MonDico2.items)
    
End Sub

[/code]

Je suis vraiment débutant , c'est en parcourant divers forum que j' en suis arrivé à ce code.


Cordialement