Gestion d'insertion dans un tableau, recherche doublon

Bonjour à tous,

Je dispose de deux onglets, dans Onglet 1 un produit par ligne, sa couleur, et une quantité saisi pour l'utilisateur. Ex : Pantalon, Bleue, 3

Dans l'onglet 2, autant de tableau que de produits. Par exemple un tableau nommé "Pantalon" qui contient 3 Cellules Pantalon, Bleue, 3. Un tableau "Chaussures" ect..

Dans l'onglet 1, lorsque l'utilisateur saisi une quantité, je détecte l’événement et j’écris dans l'onglet 2 et son tableau correspondant. Ex : l'utilisateur saisi Chaussure, Noire, 2. Alors j'insère dans le tableau nommé "Chaussure" ces informations. Jusque là j'arrive à faire ce cas simple, un code simplifié :

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Value > 0 Then
        Set Usine_lr = Worksheets("Onglet 2").ListObjects("Chaussure").ListRows.Add(AlwaysInsert:=True)
        With Usine_lr.Range
            .Cells(1, 1).Value = "Chaussure"
            .Cells(1, 2).Value = "Noire"
            .Cells(1, 3).Value = Target.Value
        End With
    Else
        MsgBox "<je dois contrôler si il y a une ligne déjà présente et la supprimer"
    End If

End Sub

Mon problème est de gérer 3 cas :

1- Pas de ligne, j'insère pour la première fois

2- Combinaison Chaussure et Noire trouvé, Si la quantité est > 0, je ré écrase la ligne

3- Combinaison Chaussure et Noire trouvé, Si quantité vide, je supprime la ligne

Je suis désolé de ne pas pouvoir vous fournir un fichier, j'ai simplifié le problème car mon fichier original est beaucoup plus lourd

Un grand merci à tous pour votre aide !

GianGian a écrit :

Bonjour à tous,

Je suis désolé de ne pas pouvoir vous fournir un fichier, j'ai simplifié le problème car mon fichier original est beaucoup plus lourd

Bonjour et bienvenue

Je pense quand même nécessaire de donner un fichier simplifié ... supprime tout ce qui est superflu au regard du sujet. C'est important pour savoir comment tu as structuré t disposé tes tableaux.

Ok!

Voici un fichier d'exemple en PJ, je l'ai adapté pour qu'il soit parlant donc ça ne correspond pas tout à fait à mon précédent exemple mais la finalité est la même

Merci, c'est plus clair quant à la structuration des données. Je vais tâcher de ne pas modifier les emplacements car je suppose qu'il y a d'autres choses sur la feuille.

Quelques écarts pour le moment :

• les tableaux sont côté à côte, sinon il faut gérer l'emplacement disponible entre tableaux (cela peut se faire)
• je n'efface pas les lignes (cela pourra se faire), le code est un peu complexe car il faut tout transvaser dans un tableau, le trier, le réduire, le transposer et le ré-écrire !
• ATTENTION = j'ai repris l'idée de ton code, mais si tu supprimes plusieurs valeurs en même temps cela ne fonctionne plus !! à aménager aussi

Private Sub Worksheet_Change(ByVal Target As Range)
Application.MoveAfterReturn = False

Dim NomProduit As String
Dim Couleur As String
Dim NomClient As String
Dim ici As Range

' Detection saisie quantité
If Not Intersect(Target, Columns("C:D")) Is Nothing Then

    ' données caractéristiques
    NomProduit = Cells(Target.Row, 1).Value
    Couleur = Cells(Target.Row, 2).Value
    NomClient = Cells(1, Target.Column).Value

    If NomProduit <> "" And Target.Row > 1 Then

        With Sheets("Onglet 2").ListObjects(NomClient).ListColumns(1).Range
            ok = False
            Set ici = .Find(NomProduit, LookIn:=xlValues)
            If Not ici Is Nothing Then ' on a trouvé le produit
                prem = ici.Address
                Do
                    If ici.Offset(0, 1) = Couleur Then ok = True ' on a trouvé la couleur
                    If Not ok Then Set ici = .FindNext(ici)      ' sinon on boucle sur les autres lignes produit
                Loop While Not ici Is Nothing And ici.Address <> prem And Not ok
            End If
        End With

        With Sheets("Onglet 2").ListObjects(NomClient)
            If ok Then
                ligne = ici.Row - Sheets("Onglet 2").ListObjects(NomClient).HeaderRowRange.Row
                If Target.Value = "" Or Target.Value = 0 Then
                    ' on devrait supprimer ... pour le moment c'est à 0
                    .DataBodyRange.Cells(ligne, 3) = 0
                Else
                    ' on met à jour
                    .DataBodyRange.Cells(ligne, 3) = Target.Value
                End If
            Else
                If Target.Value = "" Or Target.Value = 0 Then
                    ' on ne fait rien
                Else
                    ' on ajoute la ligne
                    .ListRows.Add
                    ligne = .ListRows.Count
                    .DataBodyRange.Cells(ligne, 1) = NomProduit
                    .DataBodyRange.Cells(ligne, 2) = Couleur
                    .DataBodyRange.Cells(ligne, 3) = Target.Value
                End If
            End If
        End With

    End If
End If

End Sub

Bonjour Steelson,

Merci Beaucoup ! j'ai testé ton code que je comprends très bien et il est conforme à ma demande :)

Cependant comme tu le dis, je n'avais pas pensé au cas où le client supprime plusieurs valeurs de sa colonne, j'aimerais pouvoir gérer ce cas.

J'imagine qu'il faut faire une boucle en parcourant la sélection de cellules du client et pour chaque cellule récupérer Type de produit, couleur et le tableau concerné. Puis procéder à la mise à jour.

Je vais essayer.. je pense que je vais avoir besoin d'aide :)

C'est pas très complexe

Définis une plage comme suit

set plage = Intersect(Target, Columns("C:D"))

ensuite balaye cette plage

for each cel in plage

' ................

next

tu mets le code à la plage ces .............. en changeant target par cel

Je m'en suis sorti tout seul :)

Pour la suppression de la ligne j'ai mis l'instruction suivante qui l'air de bien marcher

.ListRows(Ligne).Delete

Merci Beaucoup !

Private Sub Worksheet_Change(ByVal Target As Range)
Application.MoveAfterReturn = False

Dim NomProduit As String
Dim Couleur As String
Dim NomClient As String
Dim ici As Range

' Detection saisie quantité
If Not Intersect(Target, Columns("C:D")) Is Nothing Then

    Dim Cell As Range
    For Each Cell In Selection
        ' données caractéristiques
        NomProduit = Cells(Cell.Row, 1).Value
        Couleur = Cells(Cell.Row, 2).Value
        NomClient = Cells(1, Cell.Column).Value
        MsgBox NomProduit & " " & Couleur & " " & NomClient

            If NomProduit <> "" And Cell.Row > 1 Then
                With Sheets("Onglet 2").ListObjects(NomClient).ListColumns(1).Range
                    ok = False
                    Set ici = .Find(NomProduit, LookIn:=xlValues)
                    If Not ici Is Nothing Then ' on a trouvé le produit
                        prem = ici.Address
                        Do
                            If ici.Offset(0, 1) = Couleur Then ok = True ' on a trouvé la couleur
                            If Not ok Then Set ici = .FindNext(ici)      ' sinon on boucle sur les autres lignes produit
                        Loop While Not ici Is Nothing And ici.Address <> prem And Not ok
                    End If
                End With

                With Sheets("Onglet 2").ListObjects(NomClient)
                    If ok Then
                        Ligne = ici.Row - Sheets("Onglet 2").ListObjects(NomClient).HeaderRowRange.Row
                        If Cell.Value = "" Or Cell.Value = 0 Then
                            ' on supprime la ligne
                            .ListRows(Ligne).Delete
                        Else
                            ' on met à jour
                            .DataBodyRange.Cells(Ligne, 3) = Cell.Value
                        End If
                    Else
                        If Cell.Value = "" Or Cell.Value = 0 Then
                            ' on ne fait rien
                        Else
                            ' on ajoute la ligne
                            .ListRows.Add
                            Ligne = .ListRows.Count
                            .DataBodyRange.Cells(Ligne, 1) = NomProduit
                            .DataBodyRange.Cells(Ligne, 2) = Couleur
                            .DataBodyRange.Cells(Ligne, 3) = Cell.Value
                        End If
                    End If
                End With
            End If
    Next

End If

End Sub

Bravissimo ... tu peux cliquer sur le V de la victoire pour clôturer ce fil.

Bon en fait j'ai un autre problème..

Quand l'utilisateur saisit les quantités sans appuyer sur "Entrée" mais en utilisant les flèches du clavier, l'évènement n'est pas détecté et donc rien ne se passe :(

Tu aurais une idée ?

C'est à cause de ta selection

change comme ceci

For Each Cell In Intersect(Target, Columns("C:D"))

ou comme proposé ici https://forum.excel-pratique.com/excel/gestion-d-insertion-dans-un-tableau-recherche-doublon-145723#p896518

Ca fonctionne, Merci encore !

Je marque le sujet résolu ;)