Concordance Nom Prénom sur 2 colonnes différentes

Le 07/03/2023 à 20:00

Bonjour à tous,

J'ai récemment décidé de me lancer dans le vba pour gérer des listes de patients (inscrits à des ateliers). Mais je suis confrontée à quelques limites.

Intérêt de mon excel : inscrire les patients à des ateliers, selon les places dispos, avec une liste d'attente si atelier complet.

ET Supprimer un patient de tous ses ateliers lorsqu'il quitte l'hôpital. Et c'est là mon problème.

Fichier dispo pour visualiser sa présentation

Pour cela j'ai crée un userform où on rentre nom + prénom et avec la fonction find je lui demande de trouver le rang de chacune de ces 2 textbox. Sauf que lorsque 2 (ou plusieurs) patients ont le même prénom OU le même nom, mon code actuel ne peut pas comparer les différentes possibilités car il ne trouve pas de concordance de rang. Et je ne sais pas comment le faire comparer plusieurs rang (avec le même nom par exemple) avec le prénom ou inversement.

Je n'arrive pas vraiment à utiliser la fonction Loop ou Findnext, donc voilà si quelqu'un a une idée pour arranger cette affaire...

Merci d'avance pour votre aide :)

Voilà mon code actuel :

Private Sub CommandButton1_Click()

Dim adresse_nom As Range
Dim adresse_prenom As Range

nom = TextBox1.Value
prenom = TextBox2.Value
derniereligne = Cells(Rows.Count, 1).End(xlUp).Row

'Supprimer la ligne sur feuille Inscription

Sheets("Inscription").Activate

Set adresse_nom = Range("A1:A1000").Find(nom, lookat:=xlWhole)
Set adresse_prenom = Range("B1:B1000").Find(prenom, lookat:=xlWhole)

If adresse_nom Is Nothing Or adresse_prenom Is Nothing Then
MsgBox ("Êtes vous sur de l'orthographe du nom ou du prénom?")
Else

If adresse_nom.Row <> adresse_prenom.Row Then

?????????

MsgBox "Êtes vous sur de l'orthographe du nom ou du prénom?"
End If

If adresse_nom.Row = adresse_prenom.Row Then
Rows(adresse_nom.Row).Delete
MsgBox "Patient supprimé"
End If
End If

'Est-ce que ce patient était en atelier collage ?

Sheets("Collage").Activate

Set adresse_nomcol = Range("A1:A1000").Find(nom, lookat:=xlWhole)
Set adresse_prenomcol = Range("B1:B1000").Find(prenom, lookat:=xlWhole)

If adresse_nomcol Is Nothing Or adresse_prenomcol Is Nothing Then
Set adresse_nomla = Range("G1:G1000").Find(nom, lookat:=xlWhole)
Set adresse_prenomla = Range("H1:H1000").Find(prenom, lookat:=xlWhole)
If adresse_nomla Is Nothing Or adresse_prenomla Is Nothing Then
Sheets("Modelage").Activate
Else

'Est-ce que le patient est en liste d'attente pour le collage?
v3.xlsm
If adresse_nomla.Row = adresse_prenomla.Row Then
adresse_nomla.Resize(7, 11).ClearContents
MsgBox "Patient retiré de la liste d'attente de collage"
Sheets("Modelage").Activate
End If
End If

Else
If adresse_nomcol.Row = adresse_prenomcol.Row Then
adresse_nomcol.Resize(1, 5).ClearContents
MsgBox "Patient retiré de l'atelier collage"
Sheets("Modelage").Activate
End If
End If

End Sub

Après si vous avez des idées pour simplifier la suppression de patient sans faire une recherche page par page, je suis très intéressée également!

Merci d'avance à tous !

15v3.xlsm (58.36 Ko)
Le 08/03/2023 à 06:36

Bonjour,

Suggestion: Ne serait-il pas plus simple d'ajouter, en plus du nom et du prénom, le N° de la chambre, ça simplifierait les recherches.

Cdlt

Le 08/03/2023 à 21:06

Bonjour,

Merci de votre proposition.

Mais cela ne semble pas régler le problème... Si mon code s'arrête au premier "Martin" (par exemple) qu'il rencontre et que le numéro de chambre ne correspond pas, il n'est pas capable de passer au prochain "Martin"?

De plus certaines de nos chambres sont doubles, donc il peut y avoir 2 personnes au même numéro de chambre.

Le 09/03/2023 à 07:30

Bonjour,

Alors voici, traitement des 4 feuilles "Inscription, Collage, Modelage, Gym":

Option Explicit
Option Compare Text

Private Sub CommandButton1_Click()
    Dim x As Range, Adr_Nom As Variant
    Dim Nom As String, Prenom As String, Inscription As String, Collage As String, Modelage As String, Gym As String
    Dim DerLig_f1 As Long, DerLig_f2 As Long, DerLig_f3 As Long, DerLig_f4 As Long
    Dim DerCol_f2 As Long, DerCol_f3 As Long, DerCol_f4 As Long
    Dim Lig As Long
    Dim f1 As Worksheet, f2 As Worksheet, f3 As Worksheet, f4 As Worksheet

    Set f1 = Sheets("Inscription")
    Set f2 = Sheets("Collage")
    Set f3 = Sheets("Modelage")
    Set f4 = Sheets("Gym")

    Nom = TextBox1.Value
    Prenom = TextBox2.Value
    DerLig_f1 = f1.Cells(Rows.Count, 1).End(xlUp).Row

Inscription:
    'Supprimer la ligne sur feuille Inscription
    With f1.Range("A1:A" & DerLig_f1)
        Set x = .Find(Nom, lookat:=xlWhole)
        If Not x Is Nothing Then
            Adr_Nom = x.Address
            Lig = x.Row
            Do
                If f1.Cells(x.Row, "B") = Prenom Then
                    f1.Rows(x.Row).Delete
                    Inscription = "Ok"
                    GoTo Collage
                Else
                    Set x = .FindNext(x)
                End If
            Loop While Not x Is Nothing And Lig <> x.Row
        End If
    End With

Collage:
    'Supprimer la ligne sur feuille Collage
    DerLig_f2 = f2.Cells.SpecialCells(xlCellTypeLastCell).Row
    DerCol_f2 = f2.Cells.SpecialCells(xlCellTypeLastCell).Column
    With Range(f2.Cells(1, "A"), f2.Cells(DerLig_f2, DerCol_f2))
        Set x = .Find(Nom, lookat:=xlWhole)
        If Not x Is Nothing Then
            Adr_Nom = x.Address
            Do
                If f2.Cells(x.Row, x.Column + 1) = Prenom Then
                    Range(f2.Cells(x.Row, x.Column), f2.Cells(x.Row, x.Column + 4)).Delete
                    Collage = "Ok"
                    GoTo Modelage
                Else
                    Set x = .FindNext(x)
                End If
            Loop While Not x Is Nothing And x.Address <> Adr_Nom
        End If
    End With

Modelage:
    'Supprimer la ligne sur feuille Modelage
    DerLig_f3 = f3.Cells.SpecialCells(xlCellTypeLastCell).Row
    DerCol_f3 = f3.Cells.SpecialCells(xlCellTypeLastCell).Column
    With Range(f3.Cells(1, "A"), f3.Cells(DerLig_f3, DerCol_f3))
        Set x = .Find(Nom, lookat:=xlWhole)
        If Not x Is Nothing Then
            Adr_Nom = x.Address
            Do
                If f3.Cells(x.Row, x.Column + 1) = Prenom Then
                    Range(f3.Cells(x.Row, x.Column), f3.Cells(x.Row, x.Column + 4)).Delete
                    Modelage = "Ok"
                    GoTo Gym
                Else
                    Set x = .FindNext(x)
                End If
            Loop While Not x Is Nothing And x.Address <> Adr_Nom
        End If
    End With

Gym:
    'Supprimer la ligne sur feuille Gym
    DerLig_f4 = f4.Cells.SpecialCells(xlCellTypeLastCell).Row
    DerCol_f4 = f4.Cells.SpecialCells(xlCellTypeLastCell).Column
    With Range(f4.Cells(1, "A"), f4.Cells(DerLig_f4, DerCol_f4))
        Set x = .Find(Nom, lookat:=xlWhole)
        If Not x Is Nothing Then
            Adr_Nom = x.Address
            Do
                If f4.Cells(x.Row, x.Column + 1) = Prenom Then
                    Range(f4.Cells(x.Row, x.Column), f4.Cells(x.Row, x.Column + 4)).Delete
                    Gym = "Ok"
                    GoTo Sortie
                Else
                    Set x = .FindNext(x)
                End If
            Loop While Not x Is Nothing And x.Address <> Adr_Nom
        End If
    End With

Sortie:
    If Inscription = "Ok" Or Collage = "Ok" Or Modelage = "Ok" Or Gym = "Ok" Then
        MsgBox "Le patient " & Nom & " " & Prenom & "est retiré de toutes les listes"
    Else
        MsgBox "Le patient " & Nom & " " & Prenom & " est introuvable"
    End If

    'Libération de la mémoire
    Set x = Nothing
    Set f1 = Nothing
    Set f2 = Nothing
    Set f3 = Nothing
    Set f4 = Nothing
End Sub

Cdlt

Le 09/03/2023 à 18:49

Bonjour,

Wahou merci pour cette efficacité! Ca a l'air de bien fonctionner, merci beaucoup d'avoir pris ce temps !

Rechercher des sujets similaires à "concordance nom prenom colonnes differentes"