Rajout de code VBA

[taz067]

Hello
j’ai dans mon fichier de reservation un bouton de recherche de placement avec le code suivant

Sub RechercheInfo()
    Dim ws As Worksheet
    Dim nomRecherche As String
    Dim plageNom As Range
    Dim cell As Range
    Dim ligneTrouvee As Range
    Dim msg As String
    Dim ligne As Long
    
    ' Définir la feuille de travail (onglet réservation)
    Set ws = ThisWorkbook.Sheets("Réservation")
    
    ' Demander à l'utilisateur de saisir un nom via une InputBox
    nomRecherche = InputBox("Entrez le nom à rechercher :", "Recherche de nom")
    
    ' Vérifier si l'utilisateur a saisi un nom
    If nomRecherche = "" Then
        MsgBox "Aucun nom saisi. Opération annulée.", vbExclamation
        Exit Sub
    End If
    
    ' Définir la plage de recherche pour la colonne "Nom" (C2:C168)
    Set plageNom = ws.Range("C2:C168")
    
    ' Rechercher le nom dans la colonne "Nom" (ici la colonne C)
    Set ligneTrouvee = Nothing
    For Each cell In plageNom
        If LCase(cell.Value) = LCase(nomRecherche) Then
            Set ligneTrouvee = cell.EntireRow
            Exit For
        End If
    Next cell
    
    ' Si le nom n'est pas trouvé
    If ligneTrouvee Is Nothing Then
        MsgBox "Le nom '" & nomRecherche & "' n'a pas été trouvé.", vbExclamation
        Exit Sub
    End If
    
    ' Récupérer les informations dans les colonnes D, E, et G
    ' En supposant que les colonnes D, E, et G contiennent les informations respectivement
    msg = "Nom : " & ligneTrouvee.Cells(1, 3).Value & vbCrLf & _
          "Prénom : " & ligneTrouvee.Cells(1, 4).Value & vbCrLf & _
          "Nombre de places : " & ligneTrouvee.Cells(1, 5).Value & vbCrLf & _
          "Tables : " & ligneTrouvee.Cells(1, 7).Value
    
    ' Afficher le message dans une MsgBox
    MsgBox msg, vbInformation, "Informations Placement"
End Sub

Ça fonctionne très bien, sauf qu’en cas de doublon du nom, le code ne m’affiche qu’un seul nom avec les données de la ligne, comment écrire le code pour que le message box m’affiche tous les noms recherchés, incluant les doublons…
merci d’avance a l’ame charitable pouvant me dépanner

[FFO]

Bonjour

Ci-joint ma proposition

Onglet “Réservation” cliques sur le bouton “Recherche info”

A l’invite de la boite de dialogue saisis un nom de la colonne “C”

Testes un qui est unique puis un présent en double dans cette colonne

Fais moi un retour

Rajout code VBA.xlsm (23,5 Ko)

Si cela te convient tu peux récupérer le code dans la macro “Rechercheinfo2”

[taz067]

Merci FFO
Top ça fonctionne

[FFO]

Parfait parfait

Ravi de t’avoir aidé

Au plaisir une prochaine fois

[Cow18]

avec un TS, la recherche est assez facile en utilisant ses propriétés.

Sub M_RechercheInfo_TS()
     Dim NomRecherche, r, s
     With Range("Tableau1").ListObject
          If .ListRows.Count = 0 Then Exit Sub
          NomRecherche = Application.InputBox("Entrez le nom à rechercher :", "Recherche de nom", Type:=2)
          If NomRecherche = False Or NomRecherche = "" Then Exit Sub     'annulé ou vide ?
          r = Application.IfError(Application.Match(NomRecherche, .ListColumns("Noms").DataBodyRange, 0), 0)     'quelle ligne dans la colonne "Noms", erreur=0
          If r = 0 Then
               MsgBox "Le nom '" & NomRecherche & "' n'a pas été trouvé.", vbExclamation
          Else
               With .DataBodyRange           'dans le databodyrange du TS
                    s = "Nom : " & .Cells(r, 1).Value2 & vbLf & _
                        "Prénom : " & .Cells(r, 2).Value2 & vbLf & _
                        "Nombre de places : " & .Cells(r, 3).Value2 & vbLf & _
                        "Tables : " & .Cells(r, 5).Value
                    MsgBox s, vbInformation, "Informations Placement"
               End With
          End If
     End With
End Sub

Rajout code VBA.xlsm (25,5 Ko)

[taz067]

Hello Cow18
j’ai adapté et testé ta solution sur mon fichier, mais elle n’est pas probante pour moi
le résultat est le suivant

alors qu’il devrait être comme celle de FFO

[Cow18]

bonjour taz067,

pouvez-vous télécharger votre fichier ? le prénom semble à une date et il n’y a pas une date dans le TS. (Je suppose qu’on a oublié ce point quelque part avec le “.cells(r,x).value2, comme ca,c’est une cellule de la feuille active ou lieu d’une cellule dans le TS)

[taz067]

C’est le fichier pour lequel tu m’as, avec succès, modifié le code VBA dernièrement, avec l’ajout contact, sauf que la macro concerne l’onglet Réservation
Ps je réponds avec mon téléphone, je n’ai pas le fichier sur celui-ci

Edit: rajout du fichier récupéré sur l’autre demande
Réservation loto (1).xlsm (153,3 Ko)

Appeler une macro si nom inexistant

Hello j’ai un fichier d’attribution de place pour un loto avec des macros et actuellement si je veut inscrire une personne sur l’onglet « Table_Resa » et que cette personne est pas dans l’onglet « Contact », pour le moment, je le rajoute avec la macro du modul4 et je voudrais que je puisse rajouter sans sortir de l’onglet la personne à l’onglet « Contact » j’ai mis ce code dans le modul 1, mais elle tourne en boucle et ne ressort pas de la macro If plageNoms.Cells(i, 1).Value = "" Then …

[Cow18]

Sub M_RechercheInfo_TS()
     Dim NomRecherche, r, s, iPlaces, iTable
     With Range("Tab_resa").ListObject
          iPlaces = .ListColumns("Places").Index     'N° de la listcolumn "Places"
          iTable = .ListColumns("Table").Index     'N° de la listcolumn "Table"
          If .ListRows.Count = 0 Then Exit Sub
          NomRecherche = Application.InputBox("Entrez le nom à rechercher :", "Recherche de nom", Type:=2)
          If NomRecherche = False Or NomRecherche = "" Then Exit Sub     'annulé ou vide ?
          r = Application.IfError(Application.Match(NomRecherche, .ListColumns("Nom").DataBodyRange, 0), 0)     'quelle ligne dans la colonne "Nom", erreur=0
          If r = 0 Then
               MsgBox "Le nom '" & NomRecherche & "' n'a pas été trouvé.", vbExclamation
          Else
               With .DataBodyRange           'dans le databodyrange du TS
                    s = "Nom : " & .Cells(r, 3).Value2 & vbLf & _
                        "Prénom : " & .Cells(r, 4).Value2 & vbLf & _
                        "Nombre de places : " & .Cells(r, iPlaces).Value2 & vbLf & _
                        "Tables : " & .Cells(r, iTable).Value
                    MsgBox s, vbInformation, "Informations Placement"
               End With
          End If
     End With
End Sub

c’est important que vous comprenez que le “r” de la ligne dans le tableau n’ai rien à voir avec la ligne réelle dans la feuille. Il faut traiter ce tableau comme un objet indépendant mais qui a quelque relation avec sa feuille. La ligne réelle = la ligne de l’entête du tableau (Headerrowrange) + ce r.

Idem pour le numéro de la colonne, par exemple,si on ne sait pas encore celui de la colonne “Table” (on peut par exemple ajouter des colonnes, le variable “iTable” calcule l’index correct dans le TS; Maintenant vous pouvez déplacer le tableau entier dans sa feuille (=insérer des lignes à gauche ou en haut, renommer la feuille, déplacer vers une autre feuille, Il ne faut plus changer le code VBA, avec “Range(« Tab_resa »).ListObject”, excel sait l’adresse et tout le reste.

Le nom et prénom sont pour le moment fixés dans la 3ième et 4ième colonne du TS, les places et la table sont dans les colonne “iPlaces” et “iTable” du tableau, maintenant 5 et 7,mais supposons que vous insérez une colonnes avant la colonne E, ces 2 variables changent, mais vous ne devez pas changer la macro, la macro s’ajuste tout seul. Ici aussi, iTable=5 parce que le TS commence dans la colonne A, mais si vous déplacez le tableau vers droite, iTable reste 5 même si sa colonne réelle est à ce moment par exemple 100.

Donc ce tableau est un objet avec ses propriétés que vous permettent d’une manière pratique d’ajouter/supprimer des listrows ou listcolumns, d’utiliser ses propres numberformats, fonts, etc et aussi ces MFCs (pas à 100%)

. r = Application.IfError(Application.Match(NomRecherche, .ListColumns("Nom").DataBodyRange, 0), 0) 

l’application.match “Application.Match(NomRecherche, .ListColumns(« Nom »). DataBodyRange , 0)” recherche le nom “exact” (dû au premier zéro entre les parenthèses) dans la colonne “Nom” du tableau (sans l’entête dû au “databodyrange”) en ignorant les majuscules/miniscules. Si ce nom n’y est pas, cela provoque une erreur qui est traitée par l’application.iferror (“Application.IfError(…., 0) avec … la partie grasse ici dessus) qui change l’erreur par ce dernier 0 entre les parenthèses. Comme ça, r est toujours un chiffre, les zéros sont les “introuvables” et les valeurs positives sont le numéro du listrow dans le TS

Réservation loto (1) (1).xlsm (156,5 Ko)

[Daniel77]

Bonjour à tous,

Je trouve qu’écrire :

          r = Application.Match(NomRecherche, .ListColumns("Nom").DataBodyRange, 0)     'quelle ligne dans la colonne "Nom", erreur=0
          If IsNumeric(r) Then
            With .DataBodyRange           'dans le databodyrange du TS
              s = "Nom : " & .Cells(r, 3).Value2 & vbLf & _
                "Prénom : " & .Cells(r, 4).Value2 & vbLf & _
                "Nombre de places : " & .Cells(r, iPlaces).Value2 & vbLf & _
                "Tables : " & .Cells(r, iTable).Value
              MsgBox s, vbInformation, "Informations Placement"
            End With
          Else
            MsgBox "Le nom '" & NomRecherche & "' n'a pas été trouvé.", vbExclamation
          End If

est un poil plus simple.

Daniel

[taz067]

Re, merci pour les explications, mais ce tableau est en service depuis quelques années déjà et il n’est pas prévue de rajouter de colonne, et comme déjà signaler la solution de FFO me convient et est parfaitement fonctionnelle en l’état
mais je me pencherais quand même sur ta proposition pour essayer de la comprendre

EDIT:
@Cow18 ta macro ne m’affiche pas les doublons

comme le fait la macro modifié de @FFO

[Cow18]

avec la macro que j’ai vu, ces autres réservations ne sont pas encore montré,peut-être une inconnue.

Sub M_RechercheInfo_TS()
     Dim NomRecherche, r, s, iPlaces, iTable, Arr
     With Range("Tab_resa").ListObject
          iPlaces = .ListColumns("Places").Index     'N° de la listcolumn "Places"
          iTable = .ListColumns("Table").Index     'N° de la listcolumn "Table"
          If .ListRows.Count = 0 Then Exit Sub
          NomRecherche = Application.InputBox("Entrez le nom à rechercher :", "Recherche de nom", Type:=2)
          If NomRecherche = False Or NomRecherche = "" Then Exit Sub     'annulé ou vide ?
          Arr = Evaluate(Replace("if(tab_resa[nom]=#,row(tab_resa),99999)", "#", Chr(34) & NomRecherche & Chr(34)))
          s = "Nom" & vbTab & "Prénom" & vbTab & "Nombre de places,Tables : "
          With .DataBodyRange                'dans le databodyrange du TS
               For i = 1 To UBound(Arr)
                    r = WorksheetFunction.Small(Arr, i)
                    If r < 99999 Then
                         r = r - .Row + 1
                         s = s & vbLf & .Cells(r, 3).Value2 & vbTab & .Cells(r, 4).Value2 & vbTab & .Cells(r, iPlaces).Value2 & vbTab & .Cells(r, iTable).Value
                    Else
                         If i = 1 Then s = s & vbLf & "aucune table"
                         Exit For
                    End If
               Next
                        End With
     End With
      MsgBox s, , "Informations Placement : " & UCase(NomRecherche)
End Sub

[Cow18]

une méthode “oldschool” avec un filter avancé.

voir feuille “Advanced”

Réservation loto (1) (1).xlsm (165,1 Ko)