Vérifier et éviter les doublons lors d'ajout de ligne dans tableau

Le 29/06/2020 à 11:37

Bonjour,

TABprestataire est mon tableau de facturation : avec différents prestataires de services sur une année.

  • Prestataire de service en première colonne
  • Année = 12 mois, sur les 12 prochaines colonnes.

Ce tableau est évolutif : Il peut, durant une année, y avoir un AJOUT ou une SUPRESSION de prestataire (donc de ligne).

Des boutons / Macros (« Ajout prestataires » et « Suppression prestataire ») sont là pour cela.

Problématique :

  • Lors d’un ajout : Ma macro ne vérifie pas si la « valeur » est déjà présente. Et auquel cas, mettre une msgbox disant « le prestataire est déjà présent » serait l'idéal.
  • Lors de la suppression : si l’utilisateur écrit depuis la msgbox un prestataire inexistant ou mal orthographié, ma macro bug.

Dans ce cas j’aimerais savoir comment faire pour : exit sub suivi d’une msgbox « prestataire inexistant. Vérifiez l’orthographe. »

Ajout :

Sub INPBX_AJOUT_PRESTATAIRE()

'********************************
'Procédure permettant d'incrémenter automatiquement le tableau TABprestations avec
'le nouveau prestataire depuis la saisie de l'INPUTBOX
'********************************

Range("B15").End(xlDown)(2) = InputBox("Ajouter votre nouveau prestataire.", "Ajout prestataire.")

End Sub

Suppression:

Sub INPBX_SUPPRESSION_PRESTATAIRE()

'***********************************
'Définition des variables
'***********************************

Dim code As String
Dim CellTrouvee As Range

'***********************************
'Rechercher dans le tableau TABprestations
'le prestataire à supprimer depuis une inputbox
'***********************************

code = InputBox("Saisir la prestation à supprimer.", "Suppression prestataire")

If code = "" Then Exit Sub

Set CellTrouvee = Range("B:B").Find(what:=code, LookIn:=xlValues, lookat:=xlWhole)

    If Application.WorksheetFunction.CountIf(Range("B15:B" & Cells(Rows.Count, "B").End(xlUp).Row), code) = 0 Then
        MsgBox "Prestataire introuvable. Vérifeir l'orthographe."
        Exit Sub
    End If

'If Application.WorksheetFunction.CountIf(Range("   chercher dans la colonne 1 du tableau " TABprestations"  " & Cells(Rows.Count, "B").End(xlUp).Row), code) = 0 Then
'   MsgBox "Prestataire introuvable. Vérifeir l'orthographe."
'    Exit Sub
'End If

CellTrouvee.EntireRow.Delete

End Sub

Je vous remercie d’avoir pris le temps de me lire et pour votre future réponse.

Au plaisir de vous lire.

Amicalement.

Ps : je joint le fichier avec le tableau et les macros.

11excel-pratique.xlsm (69.85 Ko)
Le 29/06/2020 à 12:17

Bonjour,

Voilà une première partie pour l'ajout d'un prestataire, je reviendrais plus tard pour la deuxième partie 

Sub INPBX_AJOUT_PRESTATAIRE()
Dim BD As Worksheet
Dim Presta As String
Dim i As Integer, PremLig As Integer, DernLig As Integer

'********************************
'Procédure permettant d'incrémenter automatiquement le tableau TABprestations avec
'le nouveau prestataire depuis la saisie de l'INPUTBOX
'********************************

Set BD = ThisWorkbook.Worksheets("PRESTATIONS")
PremLig = 15
DernLig = BD.Range("B" & BD.Rows.Count).End(xlUp).Row

Presta = InputBox("Ajouter votre nouveau prestataire.", "Ajout prestataire.")
If Presta = "" Then Exit Sub

For i = PremLig To DernLig
    If UCase(BD.Cells(i, 2)) = UCase(Presta) Then MsgBox "Le prestataire existe déjà dans la liste.", vbExclamation, "Ajout d'un prestataire": Exit Sub
Next i
BD.ListObjects("TABprestations").ListRows.Add (1)
BD.Range("B15") = Presta

End Sub
Le 29/06/2020 à 13:34

Voilà le code qui devrais répondre à tes deux questions :

Dim BD As Worksheet
Dim Presta As String
Dim i As Integer, PremLig As Integer, DernLig As Integer

Sub INPBX_AJOUT_PRESTATAIRE()

Set BD = ThisWorkbook.Worksheets("PRESTATIONS")
PremLig = 15
DernLig = BD.Range("B" & BD.Rows.Count).End(xlUp).Row

Presta = InputBox("Ajouter votre nouveau prestataire.", "Ajout d'un prestataire.")
If Presta = "" Then Exit Sub

For i = PremLig To DernLig
    If UCase(BD.Cells(i, 2)) = UCase(Presta) Then MsgBox "Le prestataire existe déjà dans la liste.", vbExclamation, "Ajout d'un prestataire": Exit Sub
Next i
BD.ListObjects("TABprestations").ListRows.Add (1)
BD.Range("B15") = Presta
MsgBox "Prestataire ajouté avec succès.", vbInformation, "Ajout d'un prestataire"
End Sub

Sub INPBX_SUPPRESSION_PRESTATAIRE()
Dim MSG As String

Set BD = ThisWorkbook.Worksheets("PRESTATIONS")
PremLig = 15
DernLig = BD.Range("B" & BD.Rows.Count).End(xlUp).Row

ResetCode:
Presta = InputBox("Saisir la prestation à supprimer.", "Suppression d'un prestataire")
If Presta = "" Then Exit Sub

For i = PremLig To DernLig
    If UCase(BD.Cells(i, 2)) = UCase(Presta) Then
        BD.ListObjects("TABprestations").DataBodyRange.Rows(i - PremLig + 1).Delete
        MsgBox "Prestataire supprimé avec succès.", vbInformation, "Suppression d'un prestataire"
        Exit Sub
    End If
Next i

MSG = MsgBox("Impossible de trouver le prestataire dans la liste. Merci de vérifier l’orthographe." & Chr(10) & Chr(10) & _
"Essayer à nouveau ?", vbExclamation + vbYesNo, "Suppression d'un prestataire")
If MSG = vbYes Then GoTo ResetCode

End Sub
Le 29/06/2020 à 16:49

Bonjour GGautier,

Juste super pour tes 2 codes !

Ils fonctionnent à merveille !

Merci pour le temps passé, ta rapidité et ton altruisme.

Au plaisir de te relire.

Amicalement,

Alex

Le 30/06/2020 à 08:22

Parfait si ça te convient, n'hésite pas si jamais tu as des questions

Bonne continuation, Gautier

Le 02/07/2020 à 09:05

Bon, ok j'avoue, j'ai encore besoin d'un petit coup de pouce.

Dans le code "suppression", je n'arrive pas à lire (interpréter) la ligne de code qui sélectionne la colonne à rechercher.

Je cherche à dupliquer cette macro pour d'autre "Feuil" de mon classeur, et sur ces feuilles la colonne de recherche n'est plus B mais D. (sinon tous le reste est identique)

DernLig = BD.Range("B" & BD.Rows.Count).End(xlUp).Row

Je me dis, tout simplement, je change B par D... Et là... plus rien.

Et dans le code, aucune autre ligne ne fait référence à une colonne pour recherche. Je pense qu'il faudrait chercher vers :

If UCase(BD.Cells(i, 2)) = UCase(Presta) Then
        BD.ListObjects("TABprestations").DataBodyRange.Rows(i - PremLig + 1).Delete

Mais je sèche totalement. Que veux dire "UCase"?

J'attends ton retour avec impatience.

Merci d'avance.

Le 06/07/2020 à 15:20

Bonjour :)

Alors,

DernLig = BD.Range("B" & BD.Rows.Count).End(xlUp).Row

Cette ligne de code permet de récupérer la dernière cellule non vide de la colonne B sur la feuille représentée par la variable BD (la feuille prestations)

Set BD = ThisWorkbook.Worksheets("PRESTATIONS")

En suite je compare le'ensemble des cellules de la plage définie juste au dessus et les compare à la saisie faite dans le "InpuBox". La fonction UCase() permet de mettre le contenue en majuscule.

Je m'explique, si on cherche à savoir si "PrestationN°1" existe mais que la personne saisie "prestation N°1" alors excel dira que cette valeur n'existe pas (vue qu'il différencie les majuscules et minuscules). Donc je passe tout en majuscule pour faire la comparaison.

Donc UCase(PrestationN°1)=PRESTATIONN°1, valeur comparée à PRESZTATIONN°1 donc égale, donc excel te dira que la prestation existe bel et bien (donc ok pour suppression)

J'espère que tu as compris car je répond un peu vite ^^

Rechercher des sujets similaires à "verifier eviter doublons lors ajout ligne tableau"