Vérifier l'exitance d'un élément avant de l'ajouter a une BDD

Quelqu’un pourrait m’aider a me corriger SVP.
Consulter le fichier:
Page d’accueil: Menu, Modèle 1, Nouvelle Lames, Le bouton + permet d’afficher le UF_Ajout_Lame ou il y a mon code.

Bonjour,

Voici un exemple de code permettant d'y parvenir. Il faudra bien entendu adapter quelques données de ce code générique (V1, V2, V3 et macolonne) pour ensuite l'incorporer dans votre code d'insertion.

Dim suffixe$, prefixe$, libelle$

suffixe = "-" & V1 & "-" & V2 & "-M1-" & V3 'suffixe de type -10-19-M1-H, où V1 à V3 sont à remplacer par les valeurs des contrôles de UF
prefixe = "001" 'préfixe de base

for each cell in Macolonne 'pour chaque cellule de ma colonne à tester dans BDD (!!! à adapter évidemment et à définir correctement) 
    if cell.value like "*" & suffixe then 'si la valeur de cellule en cours termine par le suffixe
        prefixe = format(left(cell.value, 3) + 1, "000") 'le préfixe prend la valeur du préfixe de cell en cours + 1
    end if
next cell

libelle = prefixe & suffixe 'libellé à ajouter = prefixe & suffixe

'.... ajouter

Si ça prend trop de temps, il faudra peut-être penser à l'adapter en pensant par un tableau dynamique.

Cdlt,

Merci pour votre proposition.

Voici mon code adapté:

suffixe = "-" & Me.ComboBox_Mois.Value & "-" & Me.ComboBox_Ann.Value & "-" & UserForm1.TextBox1.Value & "-" & Me.ComboBox_Const.Value 'suffixe de type -10-19-M1-H, où V1 à V3 sont à remplacer par les valeurs des contrôles de UF
    prefixe = "001" 'préfixe de base

    For Each cell In dl 'pour chaque cellule de ma colonne à tester dans BDD (!!! à adapter évidemment et à définir correctement)
        If cell.Value Like "*" & suffixe Then 'si la valeur de cellule en cours termine par le suffixe
            prefixe = Format(Left(cell.Value, 3) + 1, "000") 'le préfixe prend la valeur du préfixe de cell en cours + 1
        End If
    Next cell

    libelle = prefixe & suffixe 'libellé à ajouter = prefixe & suffixe
    ws_Lames.Cells(dl + 1, 2) = libelle

J'ai une erreur au niveau de :

For Each cell In dl

Incompatibilité de type avec :

dl = ws_Lames.Range("B65530").End(xlUp).Row

Oui, en fait, ici la boucle est de type "pour chaque cellule" et donc boucle sur des cellules et non sur des entiers, créant le conflit avec dl.

J'ai fait ça car j'ai supposé que votre base était organisée sous forme de tableau structuré (ce qui est quand même bien mieux dans votre cas). Vous n'auriez eu qu'à faire :

for each cell in range("montableau[macolonne]")

Sinon, il faudrait faire ainsi :

suffixe = "-" & Me.ComboBox_Mois.Value & "-" & Me.ComboBox_Ann.Value & "-" & UserForm1.TextBox1.Value & "-" & Me.ComboBox_Const.Value 'suffixe de type -10-19-M1-H, où V1 à V3 sont à remplacer par les valeurs des contrôles de UF
    prefixe = "001" 'préfixe de base
dl = ws_Lames.Range("B65530").End(xlUp).Row

    For i = 2 to dl 'pour chaque cellule de ma colonne à tester dans BDD (!!! à adapter évidemment et à définir correctement)
        If cells(i, 2).Value Like "*" & suffixe Then 'si la valeur de cellule en cours termine par le suffixe
            prefixe = Format(Left(cells(i, 2).Value, 3) + 1, "000") 'le préfixe prend la valeur du préfixe de cell en cours + 1
        End If
    Next cell

    libelle = prefixe & suffixe 'libellé à ajouter = prefixe & suffixe
    ws_Lames.Cells(dl+1, 2).value = libelle

Je commence à 2 car j'imagine que vous avez une ligne d'en-têtes.

Mais je vous recommande vivement d'utiliser la première option.

Cdlt,

Re,

J'ai utilisé

for each cell in range("montableau[macolonne]")

Et ca marche maintenant

Merci bcp.

@EGB

Re,

j'ai essayé d'adapter votre code pour faire l'inverse, cad:

j'ai une référence de type : 001-01-M1-20-A

Je veux chercher cette référence dans mon tableau ( colonne D),:

1- si elle n'existe pas je rajoute "-001" a la fin : 001-01-M1-20-A -001

2- Si elle existe par exemple j'ai : 001-01-M1-20-A-004 ca devient : 001-01-M1-20-A-005

j'ai modifié votre code pour la 1ere condition ca fonctionne, pour la 2eme ca fonctionne pas, il me rajoute 001 comme suit :

Départ: 001-01-M1-20-A-004

Résultat: 001-01-M1-20-A-004-OO5 au lieu de 001-01-M1-20-A-005

Est ce que c'est possible de me corriger ? Merci d'avance

Private Sub CommandButton1_Click()
Dim ws_Lames As Worksheet
Dim ws_Verif As Worksheet
Dim Modele As String
Dim Verif As String
Dim Trouve, Plage As Range
Dim dl As Integer
Dim suffixe$, prefixe$, libelle$

Modele = "Liste_Lame_" & UserForm1.TextBox1.Value
Verif = "Verif_" & UserForm1.TextBox1.Value
Set ws_Lames = ActiveWorkbook.Worksheets(Modele)
Set ws_Verif = ActiveWorkbook.Worksheets(Verif)
dl = ws_Lames.Range("D65530").End(xlUp).Row
dc = ws_Verif.Cells(2, 256).End(xlToLeft).Column

If Me.ListBox1.ListIndex = -1 Then
    MsgBox ("Veuillez choisir une lame")
Else
Nom_Lame = Me.ListBox1.Value
Set Plage = ws_Lames.Columns(4)
Set Trouve = Plage.Cells.Find(what:=Nom_Lame)
If Trouve Is Nothing Then
    ws_Lames.Cells(dl + 1, 4) = Me.ListBox1.Value & "-001"
Else
    If MsgBox("Lame est deja controlee, voulez vous la recontroler ? ", vbYesNo + vbExclamation + vbDefaultButton2, "Titre") = vbYes Then
        prefixe = Me.ListBox1.Value
        suffixe = "-001"
        For I = 2 To dl
            If Cells(I, 4).Value Like "*" & prefixe Then
                suffixe = Format(Right(Cells(I, 4).Value, 3) + 1, "-000")
            End If
        Next
    libelle = prefixe + suffixe
    ws_Lames.Cells(dl + 1, 4) = libelle

    End If
End If
End If

End Sub

Bonjour szaghd,

Je pense que le blocage se situait principalement au niveau de la condition avec l'opérateur Like. En principe, maintenant, ça devrait marcher :

Private Sub CommandButton1_Click()
Dim ws_Lames As Worksheet
Dim ws_Verif As Worksheet
Dim Modele As String
Dim Verif As String
Dim Trouve, Plage As Range
Dim dl As Integer
Dim suffixe$, prefixe$, libelle$

Modele = "Liste_Lame_" & UserForm1.TextBox1.Value
Verif = "Verif_" & UserForm1.TextBox1.Value
Set ws_Lames = ActiveWorkbook.Worksheets(Modele)
Set ws_Verif = ActiveWorkbook.Worksheets(Verif)
dl = ws_Lames.Range("D65530").End(xlUp).Row
dc = ws_Verif.Cells(2, 256).End(xlToLeft).Column

If Me.ListBox1.ListIndex = -1 Then
    MsgBox ("Veuillez choisir une lame")
Else
    Nom_Lame = Me.ListBox1.Value
    Set Plage = ws_Lames.Columns(4)
    Set Trouve = Plage.Cells.Find(what:=Nom_Lame)

    If Trouve Is Nothing Then
        ws_Lames.Cells(dl + 1, 4) = Me.ListBox1.Value & "-001"
    Else
        If MsgBox("Lame est deja controlee, voulez vous la recontroler ? ", vbYesNo + vbExclamation + vbDefaultButton2, "Titre") = vbYes Then
            prefixe = Me.ListBox1.Value
            suffixe = "001"
            For I = 2 To dl
                If Cells(I, 4).Value Like prefixe & "*" Then '<<<<<<<<<< ici : inversement de la comparaison
                    suffixe = Format(Right(Cells(I, 4).Value, 3) + 1, "000")
                End If
            Next
            libelle = prefixe & "-" & suffixe
            ws_Lames.Cells(dl + 1, 4).value = libelle
        End If
    End If
End If

End Sub

'NB : l'opérateur like permet de faire une comparaison (correspondance partielle) entre 1 chaine et un modèle
' le "*" signifie 0 ou plusieurs caractères quelconques
' "?" signifie 1 seul caractère quelconque
' "#" pour un chiffre
' "[mes caract]" pour une liste définie de caractères ("[A-Z]", "[0-5]", "[abcxyz]" = "[a-cx-z]")
'ex : "B3" like "?#" renvoie vrai, "B3" like "[A-C][1-4]" renvoie vrai, "B3" like "[a-z]3" renvoie faux...

Cdlt,

Re,

J'ai inversé entre "*" et préfixe mais ca n'a rien changé :/

Dans le fichier joint le code est dans le userform Recherche , en commentaire :

'------------------AJOUT SUFFIXE POUR LE CONTROLE--------------------------------------

Merci.

Salut szaghd,

Je vais essayer de faire sans ouvrir le fichier, tant que possible... En plus, ton code est vraiment super propre !

Je l'ai réorganisé notamment pour assurer qu'on teste sur les cellules de ws_lames. Si ça ne marche toujours pas, je dirais qu'il ne peut s'agir que de la valeur de dl. Je te propose un essai :

Private Sub CommandButton1_Click()

Dim ws_Lames As Worksheet, ws_Verif As Worksheet
Dim Plage As Range, Trouve as range
Dim Modele$, Verif$, suffixe$, prefixe$, libelle$
Dim dl%, I%

Modele = "Liste_Lame_" & UserForm1.TextBox1.Value
Verif = "Verif_" & UserForm1.TextBox1.Value
Set ws_Lames = ActiveWorkbook.Worksheets(Modele)
Set ws_Verif = ActiveWorkbook.Worksheets(Verif)
dc = ws_Verif.Cells(2, 256).End(xlToLeft).Column

If Me.ListBox1.ListIndex = -1 Then
    MsgBox ("Veuillez choisir une lame")
Else
    Nom_Lame = Me.ListBox1.Value
    with ws_Lames
        dl = .Range("D65530").End(xlUp).Row '<<<< vérifier valeur de dl
        Set Plage = intersect(.Columns(4), .usedrange)
        Set Trouve = Plage.Find(what:=Nom_Lame, lookin:=xlvalues)
        If Trouve Is Nothing Then
            Libelle = Me.ListBox1.Value & "-001"
        Else
            If MsgBox("Lame est deja controlee, voulez vous la recontroler ?", _
            vbYesNo + vbExclamation + vbDefaultButton2, "Titre") = vbYes Then
                prefixe = Me.ListBox1.Value
                suffixe = "001"
                For I = Trouve.row To dl
                    If .Cells(I, 4).Value Like prefixe & "*" Then
                        suffixe = Format(Right(.Cells(I, 4).Value, 3) + 1, "000")
                    End If
                Next
                libelle = prefixe & "-" & suffixe
            End If
        End If
        .Cells(dl + 1, 4).value = libelle
    end with
End If

End Sub

Comme l'autre fois, le mieux serait tout de même d'avoir un tableau structuré et de faire un each cell...

Bonne soirée,

Bonjour,

Merci j'ai essayé de bien le rédiger pour que ca soit rapidement compréhensible.

Alors j'ai testé le code et la ca fonctionne enfin, comme t'avais signalé l'autre fois le tableau structuré c'est la meilleure option.

Merci bcp :D

Nickel !

Ton code marchait déjà mais il ne devait pas coller les valeurs en bonne endroit...

Par contre, petite interrogation : la partie

If MsgBox("Lame est deja controlee, voulez vous la recontroler ?", _
            vbYesNo + vbExclamation + vbDefaultButton2, "Titre") = vbYes Then

est-elle nécessaire ?

N'est-il pas mieux d'enlever ce if et d'automatiquement générer le bon suffixe ?

Re

le if je en peux pas le supprimer car ca arrive parfois d'avoir la même référence et c'est le suffixe qui fait la différence, je laisse le choix à l'utilisateur dans ce cas la.

Salut szaghd,

Oui mais, si la référence n'existe pas : on insère la valeur 001.

Si elle existe, on insère la valeur 00+ si on répond oui ou bien "" si on répond non. Peut-être que le code serait mieux ainsi alors :

Private Sub CommandButton1_Click()

Dim ws_Lames As Worksheet, ws_Verif As Worksheet
Dim Plage As Range, Trouve as range
Dim Modele$, Verif$, suffixe$, prefixe$, libelle$
Dim dl%, I%

Modele = "Liste_Lame_" & UserForm1.TextBox1.Value
Verif = "Verif_" & UserForm1.TextBox1.Value
Set ws_Lames = ActiveWorkbook.Worksheets(Modele)
Set ws_Verif = ActiveWorkbook.Worksheets(Verif)
dc = ws_Verif.Cells(2, 256).End(xlToLeft).Column

If Me.ListBox1.ListIndex = -1 Then
    MsgBox ("Veuillez choisir une lame")
Else
    Nom_Lame = Me.ListBox1.Value
    with ws_Lames
        dl = .Range("D65530").End(xlUp).Row '<<<< vérifier valeur de dl
        Set Plage = intersect(.Columns(4), .usedrange)
        Set Trouve = Plage.Find(what:=Nom_Lame, lookin:=xlvalues)
        If Trouve Is Nothing Then
            Libelle = Me.ListBox1.Value & "-001"
            .Cells(dl + 1, 4).value = libelle
        Else
            If MsgBox("Lame est deja controlee, voulez vous la recontroler ?", _
            vbYesNo + vbExclamation + vbDefaultButton2, "Titre") = vbYes Then
                prefixe = Me.ListBox1.Value
                suffixe = "001"
                For I = Trouve.row To dl
                    If .Cells(I, 4).Value Like prefixe & "*" Then
                        suffixe = Format(Right(.Cells(I, 4).Value, 3) + 1, "000")
                    End If
                Next
                libelle = prefixe & "-" & suffixe
                .Cells(dl + 1, 4).value = libelle
            End If
        End If   
    end with
End If

End Sub

Si on ne répond pas oui, il ne se passe rien.

Petite édition entre temps (sous le if trouve is nothing)...

Re,

J'ai adapté mon code selon votre proposition, c'est vrai que si la référence n'existe pas on ajoute 001.

Merci