Supprimer une ligne selon critère

Version imprimable

31/03/2009, 14h25
NEC14

Supprimer une ligne selon critère

Bonjour à tous,

Voilà, je souhaite mettre en place un Userform de suppression d'un adhérent.
A partir d'un Combo, l'utilisateur choisira le numéro de l'adhérent.
Les infos concernant l'adhérent apparaîtra dans différentes TextBox.

Jusque là rien de très compliqué je vous l'accorde.

Lorsque l'utilisateur cliquera sur un bouton "Supprimer" alors rechercher le n° de l'adhérent dans ces 3 feuilles (Adhé, Enf, Conj) et supprimer les lignes qui y correspondent. C'est là que cela se complique pour moi.

Auriez-vous des exemples de ce type ou bien pouvez-vous me montrer la méthode pour finaliser ce travail ?

Je vous en remercie par avance
31/03/2009, 14h45
aalex_38

Regardes la commande find

Voilà ce que j'ai fait. Mais à chaque fois il me dit que l'adhérent n'a pas été trouvé.
Pouvez-vous m'apporter votre éclairage s'il vous plait ?

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
 
Private Sub Cmb1_Click()
Dim BDP As Worksheet
Dim T As Range
Dim AdheSup As String
 
    Set BDP = Worksheets("Adhé")
    AdheSup = Cb1.Value
 
'// on. vérifie si l'adhérent existe
 
    Set T = BDP.Rows(1).Find(What:=AdheSup)
    If T Is Nothing Then
    MsgBox "L'adhérent n'a pas pu être supprimé. " & "Vérifiez que vous avez sélectionné un adhérent, " & "sinon consultez votre fichier."
        Exit Sub
    Else
 
    MsgBox "Voulez-vous confirmer la suppression de cet adhérent ?", vbYesNo, vbQuestion
 
If vRep = vbYes Then
 
' // On supprime les lignes correspondant au titulaire dans chaque feuille
Worksheets("Adhé").Rows(1).Find(What:=TituASup).EntireRow.Delete
Worksheets("Enf").Rows(1).Find(What:=TituASup).EntireRow.Delete
Worksheets("Conj").Rows(1).Find(What:=TituASup).EntireRow.Delete
Else
Unload Me
End If
 
' // Retour à la feuille Accueil
Worksheets("Accueil").Visible = True
Worksheets("Accueil").Activate
 
' // On décharge le formulaire
Unload Me
End If
End Sub

31/03/2009, 17h36
aalex_38

La syntaxe a l'air bonne, essai ça :

Code:

Set T = BDP.Rows("1:1").Find(What:=MaRecherche, LookIn:=xlValues, LookAt:=xlPart)
01/04/2009, 08h27
NEC14

Bonjour à tous,

J'ai essayé selon la proposition de aalex 38 mais ça ne marche pas.
Je vous ai donc mis une partie du fichier en pièce jointe.
Merci pour votre aide
01/04/2009, 09h31
aalex_38
Au vue de ton fichier tu recherche dans la ligne 1 alors que tu devrais rechercher dans la colonne des numéros d'adhérents.

J'ai modifié ainsi et le range T est trouvé :

Code:

Set T = BDP.Columns("A:A").Find(What:=AdheSup, LookIn:=xlValues, LookAt:=xlPart)

La suite est egalement a corriger car aussi ici on supprime la ligne 1:
Code:

1 2 3 Worksheets("Adhé").Rows(1).Find(What:=TituASup).EntireRow.Delete Worksheets("Enf").Rows(1).Find(What:=TituASup).EntireRow.Delete Worksheets("Conj").Rows(1).Find(What:=TituASup).EntireRow.Delete
Edit: en fait on ne supprime sans doute rien du tout car rien n'est trouvé.
Edit2 : et on ne passe pas dans ce code (msgbox)

Autre remarque tu testes vrep, mais il n'y a pas de vrep, jepense que tu voulais faire cela :

Code:

vREP = MsgBox("Voulez-vous confirmer la suppression de cet adhérent ?", vbYesNo, vbQuestion)

Et pour l'adhérent pas besoin de le chercher à nouveau dans l'onglet Adhé, puisque tu l'a déja trouvé, donc ceci fonctionne :

Code:

Worksheets("Adhé").Rows(T.Row).EntireRow.Delete
01/04/2009, 11h26
NEC14

Bon j'ai fair les modifs. Cela marche pour l'adhérent mais pas pour les enfants et le conjoint.

Je vous remets le fichier modifié
01/04/2009, 12h28
NEC14

Alors j'y suis presque. En effet, j'arrive à supprimer l'adhérent, le conjoint qui s'y rattache, mais concernant les enfants je rencontre un problème.
Il y a parfois plusieurs lignes de suites qui concerne l'adhérent puisqu'il peut avoir plusieurs enfants et une seule ligne est supprimée.

Fichier modifié joint

Bien sur il faut faire la recherche à chaque fois !

Dans l'onglet ADhé, tu trouve la cellule correpondant à ta recherche que tu as nommée T.
Ensuite tu supprimes la ligne correspondant a cette cellule.

Tu dois rechecher les cellules dans chaque onglet, pourquoi ne pas écrire une fonction ?

En attendant, j'ai écrit ça pour l'onglet "Enf" en prenant en compte cette fois ci que l'adhérant peut être présent sur plusieurs lignes :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 Dim NumAdh As Long NumAdh = 10 With Worksheets("Enf").Range("B3:B" & Range("B65536").End(xlUp).Column) Set c = .Find(NumAdh, LookIn:=xlValues) If Not c Is Nothing Then firstAddress = c.Address Do c.Value = 5 Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address <> firstAddress End If End With End Sub

01/04/2009, 12h56
NEC14

Ma question est certainement stupide :

Tu le mets où le code, est-ce dans la feuille "Enf" ou dans le code séjà écrit ?

Je suis en train d'ecrire quelque chose (une fonction) je te le poste tout a l'heure.

Edit : j'ai fait une tentative avec FIndNext, mais je n'arrive pas à le faire fonctionner car on delete le ligne trouvée :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Function exSupprime_adherent(ByVal MaRech As String, ByVal MySheet As String, ByVal Lettrecol As String, ByVal Mondelete As Boolean) As Boolean
 
Dim F1 As Worksheet
Set F1 = Worksheets(MySheet)
 
With F1.Range(Lettrecol & "3:" & Lettrecol & Range(Lettrecol & "65536").End(xlUp).Row)
 
    Set C = .Find(MaRech, LookIn:=xlValues)
 
    If Not C Is Nothing Then
        firstAddress = C.Address
        Supprime_adherent = True
        If C.Address = firstAddress Then
            Exit Function
        End If
 
        Do
            If Mondelete = True Then
                F1.Rows(C.Row).EntireRow.Delete
            End If
 
            Set C = .FindNext(C) ''=> ici ça coince
 
        Loop While Not C Is Nothing ' And C.Address <> firstAddress
    End If
End With
End Function

suppression commentaires inutiles dans le code

Bon ce n'est pas parfait mais quelque chose qui marche (en tout cas pour moi ;))

D'abord le code du bouton modifié :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Private Sub Cmb1_Click()
Dim BDP As Worksheet
Dim T As Range
Dim AdheSup As String
 
    Set BDP = Worksheets("Adhé")
    AdheSup = Cb1.Value
 
'// on vérifie si l'adhérent existe
 
    Set T = BDP.Columns("B:B").Find(What:=AdheSup, LookIn:=xlValues, LookAt:=xlPart)
    If T Is Nothing Then
    MsgBox "L'adhérent n'a pas pu être supprimé. " & "Vérifiez que vous avez sélectionné un adhérent, " & "sinon consultez votre fichier."
        Exit Sub
    Else
 
    vrep = MsgBox("Voulez-vous confirmer la suppression de cet adhérent ?", vbYesNo, vbQuestion)
 
If vrep = vbYes Then
 
' // On supprime les lignes correspondant au titulaire dans chaque feuille
Supprime_adherent AdheSup, "Adhé", "B", True
Supprime_adherent AdheSup, "Enf", "B", True
Supprime_adherent AdheSup, "Conj", "B", True
Else
Unload Me
End If
 
' // Retour à la feuille Accueil
Worksheets("Adhé").Visible = True
Worksheets("Adhé").Activate
 
' // On décharge le formulaire
Unload Me
End If
End Sub

Ensuite la fonction dans un modile standard :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Function Supprime_adherent(ByVal MaRech As String, ByVal MySheet As String, ByVal Lettrecol As String, ByVal Mondelete As Boolean) As Boolean
 
Dim F1 As Worksheet
Set F1 = Worksheets(MySheet)
 
F1.Activate ' Je n'arrive pas a faire autrement !!!
 
With F1.Range(Lettrecol & "3:" & Lettrecol & Range(Lettrecol & "65536").End(xlUp).Row)
Do
    Set C = .Find(MaRech, LookIn:=xlValues)
    If Not C Is Nothing Then
        Supprime_adherent = True
        If Mondelete = True Then
            F1.Rows(C.Row).EntireRow.Delete
        End If
End If
Loop While Not C Is Nothing 
 
End With
End Function

Bien sur on aurait aussi pu boucler sur la plage et tester la valeur, j'ai préféré utiliser Find.

Une interrogation cependant, je n'arrive pas à orienter le find vers l'onglet choisi, je suis obligé de passer par un activate, c'est un peu dommage, si quelqu'un à la solution, je suis preneur.

Voila, j'espère qu'avec ça tu peux avancer

Edit : s'il n'y a pas trop de lignes a effacer on aurait pu aussi passer par autofilter

01/04/2009, 15h14
NEC14

C'est super aalex 38 ça marche très bien.
Merci d'avoir pris du temps à résoudre mon problème.