XL 2016 remplir usf par une double recherche

bidoutche

XLDnaute Occasionnel
Bonjour,
j'ai une feuille "Clients" où les noms sont en col. N et les prénoms en col. O. il peut y avoir des homonymes avec le même prénom (ou pas)
j'aimerai que ma recherche pour remplir USF se fasse avec le nom ET le prénom et rempli le USF

et 3e recherche (indépendante de la 1ère) par le N° de téléphone

Merci pour votre aide
 

Dranreb

XLDnaute Barbatruc
Information:
j'ai déplacé en ligne 2 les noms des contrôles, y ai mis tb1 et tb2 en N2 et O2, et j'ai obtenu un 1er résultat avec ce code :
VB:
Option Explicit
Private WithEvents CL As ComboBoxLiées, CA As ControlsAssociés, LCou As Long, TVL()
Private Sub UserForm_Initialize()
   Dim TNomsCtl(), C As Long, Ctl As MSForms.Control, RngCol As Range, TCtlInex() As String, I As Long
   Set CL = Création.ComboBoxLiées: CL.Plage Feuil1.[A4:AQ4], True
   Set CA = Création.ControlsAssociés
   TNomsCtl = Feuil1.[A2:AQ2].Value
   ReDim TCtlInex(1 To UBound(TNomsCtl, 2))
   For C = 1 To UBound(TNomsCtl, 2)
      If VarType(TNomsCtl(1, C)) = vbString Then
         On Error Resume Next
         Set Ctl = Me(TNomsCtl(1, C))
         If Err Then
            I = I + 1: TCtlInex(I) = TNomsCtl(1, C)
         Else
            If TypeOf Ctl Is MSForms.ComboBox Then
               Err.Clear: Set RngCol = Evaluate(Ctl.RowSource)
               If Err Or RngCol.Column <> C Then Set RngCol = Nothing
            Else: Set RngCol = Nothing: End If
            End If
         If RngCol Is Nothing Then CA.Add Ctl, C Else CL.Add Ctl, C: Ctl.RowSource = ""
         End If
      Next C
   If I > 0 Then
      ReDim Preserve TCtlInex(1 To I)
      MsgBox "Les contrôles suivants n'existent pas :" & vbLf & Join(TCtlInex, ", ") & ".", vbExclamation, Me.Caption
      End If
   CL.CouleurSympa
   CL.Actualiser
   End Sub
Private Sub CBnEffacer_Click()
   CL.Nettoyer
   End Sub
Private Sub CL_Change(ByVal Complet As Boolean, ByVal NbrLgn As Long)
   LCou = 0
   End Sub
Private Sub CL_Résultat(Lignes() As Long)
   If UBound(Lignes) = 1 Then
      LCou = Lignes(1)
      TVL = CL.PlgTablo.Rows(LCou).Value
      CA.ValeursDepuis TVL
      End If
   End Sub
 

Discussions similaires

Membres actuellement en ligne

Statistiques des forums

Discussions
312 305
Messages
2 087 084
Membres
103 461
dernier inscrit
dams94