Recherche intuitive VBA (EN COURS DE RESOLUTION)

misteryann

misteryann

XLDnaute Occasionnel
Bonsoir à toutes et tous
Voila le soucis:
j'ai voulu transposer un code de recherche intuitive d'un classeur (qui marche) vers un autre mais cela ne fonctionne pas.

Principe : on sélectionne le type de recherche (DI ou Libellé) puis dans la combobox on tape les mots clefs.

Si vous avez une idée...
(Je suis fan des commentaires en fin de ligne de code)

Cordialement.
Misteryann
 

Pièces jointes

  • Classeur exemple.xlsm
    46 KB · Affichages: 44
Trier par date Trier par votes
misteryann

misteryann

XLDnaute Occasionnel
Bonsoir
Le soucis commence là (surligné):

Private Sub ComboBox6_Change()
If Me.ComboBox6.ListIndex = -1 And IsError(Application.Match(Me.ComboBox6, choix1, 0)) Then
Me.ComboBox6.List = Filter(choix1, Me.ComboBox6.Text, True, vbTextCompare)
Me.ComboBox6.DropDown
Else
ComboBox6_click
End If
End Sub

Cordialement
 
Vote positif 0 Vote négatif
C

Compte Supprimé 979

Guest
Bonjour,
Un peu de réflexion de ta part serait de bon augure

Est-ce que tu vois une alimentation quelconque de ton combobox6 dans ce code !?
VB: 
Private Sub UserForm_Initialize()
  Set f = Sheets("DATA")
  Set mondico = CreateObject("Scripting.Dictionary")
  For Each c In Range(f.[A2], f.[A65000].End(xlUp))
    mondico(c.Value) = ""
  Next c
  Me.ComboBox1.List = mondico.keys
 
    Set f = Sheets("DATA")
  Set mondico = CreateObject("Scripting.Dictionary")
  For Each c In Range(f.[E2], f.[E65000].End(xlUp))
    mondico(c.Value) = ""
  Next c
  Me.ComboBox2.List = mondico.keys
 
  Set f = Sheets("DATA")
  Set mondico = CreateObject("Scripting.Dictionary")
  For Each c In Range(f.[G2], f.[G65000].End(xlUp))
    mondico(c.Value) = ""
  Next c
  Me.ComboBox3.List = mondico.keys
 
    Set f = Sheets("DATA")
  Set mondico = CreateObject("Scripting.Dictionary")
  For Each c In Range(f.[F2], f.[F65000].End(xlUp))
    mondico(c.Value) = ""
  Next c
  Me.ComboBox4.List = mondico.keys
End Sub
 
Vote positif 0 Vote négatif
BOISGONTIER

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Bonjour,

Exemple de recherche intuitive avec choix de la colonne de recherche -cases options -.

VB: 
Dim f, TblBd(), choix1(), NbCol, ligneEnreg, ColClé
Private Sub UserForm_Initialize()
  Set f = Sheets("BD")
  TblBd = f.[A1].CurrentRegion.Value
  NbCol = UBound(TblBd, 2)
  For Z = 1 To NbCol: Me("label" & Z).Caption = f.Cells(1, Z): Next Z
  For Z = NbCol + 1 To 20: Me("label" & Z).Visible = False: Me("textbox" & Z).Visible = False: Next Z
  Me.OptionButton1.Value = True
End Sub
Private Sub OptionButton1_Click()
  ColClé = 3
  ListeChoix
  Me.choixitem = "Choix du nom(frapper les premières lettres)"
End Sub

Private Sub OptionButton2_Click()
  ColClé = 5
  ListeChoix
  Me.choixitem = "Choix raison sociale"
End Sub

Sub ListeChoix()
  Set Rng = f.Range("A2:A" & f.[A65000].End(xlUp).Row).Offset(, ColClé - 1)
  choix1 = Application.Transpose(Rng)
  Tri choix1, 1, UBound(choix1)
  Me.ComboBox1.List = choix1
End Sub

Private Sub ComboBox1_Change()
   Me.ComboBox1.List = Filter(choix1, Me.ComboBox1.Text, True, vbTextCompare)
   Me.ComboBox1.DropDown
End Sub

Boisgontier
 

Pièces jointes

  • RechercheBDIntuitifOptions.xls
    336.5 KB · Affichages: 23
Dernière édition:
Vote positif 0 Vote négatif
misteryann

misteryann

XLDnaute Occasionnel
Bonjour JB
Merci. Je vais tester avec ces codes.

Bonjour BrunoM45
Il me semble que la CB6 est alimentée dans le "Sub AlimComboBox()"

Sub AlimComboBox()
With Sheets("DI")
col = Application.Match(titre, f.[A1:I1], 0)
If IsError(col) Then Exit Sub
Set mondico = CreateObject("Scripting.Dictionary")
mondico.CompareMode = vbTextCompare
a = Application.Transpose(f.Cells(2, col).Resize(f.Cells(65000, col).End(xlUp).Row).Value)
For i = LBound(a) To UBound(a)
If a(i) <> "" Then
b = Split(a(i), ",")
For j = LBound(b) To UBound(b)
mondico(b(j)) = ""
Next j
End If
Next i
choix1 = mondico.keys
Call Tri(choix1, LBound(choix1), UBound(choix1))
Me.ComboBox6.ListIndex = -1
Me.ComboBox6.List = choix1
Me.ComboBox6.SetFocus
End With
End Sub

Cordialement
 
Vote positif 0 Vote négatif
misteryann

misteryann

XLDnaute Occasionnel
Bonsoir

En fait, ça coince toujours là:

Private Sub ComboBox6_Change()
Me.ComboBox6.List = Filter(choix1, Me.ComboBox6.Text, True, vbTextCompare)
Me.ComboBox6.DropDown
End Sub

Cordialement
 

Pièces jointes

  • Classeur exemple2.xlsm
    40.6 KB · Affichages: 12
Vote positif 0 Vote négatif
C

Compte Supprimé 979

Guest
Re,

Et elles est où ta procédure d'alimentation de la combobox6 !?

VB: 
Dim f, g, TblBd(), choix1(), NbCol, ligneEnreg, ColClé
Private Sub UserForm_Initialize()
  Set f = Sheets("DI")
  TblBd = f.[A1].CurrentRegion.Value
  NbCol = UBound(TblBd, 2)
  'For Z = 1 To NbCol: Me("label" & Z).Caption = f.Cells(1, Z): Next Z
  'For Z = NbCol + 1 To 20: Me("label" & Z).Visible = False: Me("textbox" & Z).Visible = False: Next Z
  Me.OptionButton1.Value = True
 

  Set g = Sheets("DATA")
  Set mondico = CreateObject("Scripting.Dictionary")
  For Each c In Range(g.[A2], g.[A65000].End(xlUp))
    mondico(c.Value) = ""
  Next c
  Me.ComboBox1.List = mondico.keys
 
  
  Set mondico = CreateObject("Scripting.Dictionary")
  For Each c In Range(g.[E2], g.[E65000].End(xlUp))
    mondico(c.Value) = ""
  Next c
  Me.ComboBox2.List = mondico.keys
 
 
  Set mondico = CreateObject("Scripting.Dictionary")
  For Each c In Range(g.[G2], g.[G65000].End(xlUp))
    mondico(c.Value) = ""
  Next c
  Me.ComboBox3.List = mondico.keys
 

  Set mondico = CreateObject("Scripting.Dictionary")
  For Each c In Range(g.[F2], g.[F65000].End(xlUp))
    mondico(c.Value) = ""
  Next c
  Me.ComboBox4.List = mondico.keys
End Sub



Private Sub CommandButton3_Click()
'On Error Resume Next

If TextBox1 = "" Then
    'Message à l'utilisateur
    MsgBox "Saisie d'un numéro de référence obligatoire.", vbInformation
    'sortie de la procédure
    Exit Sub
End If

If TextBox1 <> "" Then
    Sheets("DI").Select
    nb_contact = 0
    For i = 2 To 5000
        If IsEmpty(Cells(i, 1)) Then
            nb_contact = i - 2
            Exit For
        End If
    Next
    Sheets("DI").Cells(nb_contact + 2, 1) = TextBox1
    Sheets("DI").Cells(nb_contact + 2, 2) = ComboBox1.Value
    Sheets("DI").Cells(nb_contact + 2, 3) = ComboBox2.Value
    Sheets("DI").Cells(nb_contact + 2, 4) = ComboBox5.Value
    Sheets("DI").Cells(nb_contact + 2, 5) = ComboBox4.Value
    Sheets("DI").Cells(nb_contact + 2, 6) = TextBox2
    Sheets("DI").Cells(nb_contact + 2, 7) = ComboBox3.Value
    Sheets("DI").Cells(nb_contact + 2, 8) = TextBox3
    Sheets("DI").Cells(nb_contact + 2, 9) = TextBox4
    Sheets("DI").Cells(nb_contact + 2, 10) = TextBox5

End If

    Sheets("Base").Select
    nb_contact = 0
    For i = 2 To 5000
        If IsEmpty(Cells(i, 1)) Then
            nb_contact = i - 2
            Exit For
    End If
    Next
    
    Sheets("BASE").Cells(nb_contact + 2, 1) = TextBox1
    Sheets("BASE").Cells(nb_contact + 2, 2) = ComboBox1.Value
    Sheets("BASE").Cells(nb_contact + 2, 3) = ComboBox2.Value
    Sheets("BASE").Cells(nb_contact + 2, 4) = ComboBox5.Value
    Sheets("BASE").Cells(nb_contact + 2, 5) = ComboBox4.Value
    Sheets("BASE").Cells(nb_contact + 2, 6) = TextBox2
    Sheets("BASE").Cells(nb_contact + 2, 7) = ComboBox3.Value
    Sheets("BASE").Cells(nb_contact + 2, 8) = TextBox3
    Sheets("BASE").Cells(nb_contact + 2, 9) = TextBox4
    Sheets("BASE").Cells(nb_contact + 2, 10) = TextBox5
    Sheets("BASE").Cells(nb_contact + 2, 11) = TextBox32
    Sheets("BASE").Cells(nb_contact + 2, 12) = TextBox33

   ' Sheets("Liste").Cells(nb_contact + 2, 17) = ComboBox5.Value
  'End If
End Sub



Private Sub OptionButton1_Click()
  ColClé = 1
  ListeChoix
  'Me.choixitem = "Choix du nom(frapper les premières lettres)"
End Sub
Private Sub OptionButton2_Click()
  ColClé = 9
  ListeChoix
  'Me.choixitem = "Choix raison sociale"
End Sub
Sub ListeChoix()
  Set Rng = f.Range("A2:A" & f.[A65000].End(xlUp).Row).Offset(, ColClé - 1)
  choix1 = Application.Transpose(Rng)
  Tri choix1, 1, UBound(choix1)
  Me.ComboBox6.List = choix1
End Sub

Private Sub ComboBox6_Change()
   Me.ComboBox6.List = Filter(choix1, Me.ComboBox6.Text, True, vbTextCompare)
   Me.ComboBox6.DropDown
End Sub
'Private Sub ComboBox6_click()
 ' For i = 1 To UBound(TblBd)
    'If TblBd(i, ColClé) = Me.ComboBox1 Then
     ' For k = 1 To NbCol
       ' Me("textbox" & k) = TblBd(i, k)
      'Next k
   ' End If
  'Next i
'End Sub



Sub Tri(a(), gauc, droi)  ' Quick sort
  ref = a((gauc + droi) \ 2)
  g = gauc: d = droi
  Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(d): d = d - 1: Loop
    If g <= d Then
       temp = a(g): a(g) = a(d): a(d) = temp
       g = g + 1: d = d - 1
    End If
  Loop While g <= d
  If g < droi Then Call Tri(a, g, droi)
  If gauc < d Then Call Tri(a, gauc, d)
End Sub

Private Sub ComboBox1_click()
  Set f = Sheets("DATA")
  Set mondico = CreateObject("Scripting.Dictionary")
  For Each c In Range(f.[A2], f.[A65000].End(xlUp))
     If c = Me.ComboBox1 Then mondico(c.Offset(, 1).Value) = ""
  Next c
  Me.ComboBox5.List = mondico.keys
  Me.ComboBox5.ListIndex = -1
End Sub
Tu auras forcément toujours le même problème, mais tu as raison de t'obstiner...
 
Vote positif 0 Vote négatif
misteryann

misteryann

XLDnaute Occasionnel
Bonsoir
Dans le premier fichier la procédure est dans le "Sub AlimComboBox()" 'voir ci-dessus

Et dans le classeur exemple2 il me semble c'est là:

Sub ListeChoix()
Set Rng = f.Range("A2:A" & f.[A65000].End(xlUp).Row).Offset(, ColCl? - 1)
choix1 = Application.Transpose(Rng)
Tri choix1, 1, UBound(choix1)
Me.ComboBox6.List = choix1
End Sub
 
Vote positif 0 Vote négatif
laurent950

laurent950

XLDnaute Accro
misteryann à dit:
Private Sub ComboBox6_Change()
Me.ComboBox6.List = Filter(choix1, Me.ComboBox6.Text, True, vbTextCompare)
Me.ComboBox6.DropDown
End Sub
Cliquez pour agrandir...
Voici le soucis
Votre tableaux choix() n'est pas reconnu dans votre module
en entête de module "UserForm1"
Dim f, g, TblBd(), choix1(), NbCol, ligneEnreg, ColClé
je devine Dim f as workseet
les autres faire pareille comme pour ce tableau = choix1() qu'elle type ? peux Etre Dim a remplacer par Publique

Private Sub ComboBox6_Change()
il faut donc le créer dans le module comme tableaux indépendant !
Dim choix1(1) As Variant ' Variable tableau a une dimension
choix1(1) = Me.ComboBox6.Value
OU
Dim choix1(1 to 1, 1 To 1) As Variant ' Variable tableau a deux dimensions
choix1(1,1) = Me.ComboBox6.Value
ici Me.ComboBox6.Value (La valeurs stocké dans la combobox à copier dans le tableaux au choix

les variables sont pas instancier
Dim f
Set f = Sheets("DI")
Set f = Sheets("DATA")

je ferais
Dim fDI as worksheet
Set fDI = worksheets("DI")

Dim fDATA as worksheet
Set fDATA = worksheets("DATA")

Je connais pas le code, mais j'ai détecté cela

cdt
 
Vote positif 0 Vote négatif
C

Compte Supprimé 979

Guest
Re,
@laurent950, pas mal vu et effectivement c'est mieux, mais ce n'est pas ça ;)
Bon allez, j'ai assez laissé chercher mister

Voici le fichier avec 2 corrections
  • La mise à jour du combobox6 à l'initialisation
  • l'ajout du paramètre "Titre" dans la sub "AlimCombobox(Titre as String"

Voili, voilà
 

Pièces jointes

  • misteryann_Classeur exemple BM.xlsm
    46.5 KB · Affichages: 33
Vote positif 0 Vote négatif

Discussions similaires

T
  • Question
XL pour MAC Recherche de mots clefs dans une cellule Texte
Réponses
2
Affichages
863
Tsr75a
T
misteryann
  • Question
XL 2016 Additionner et multiplier en VBA
Réponses
4
Affichages
483
misteryann
misteryann
S
  • Question
XL 2013 recherche intuitif semi automatique dans Combobox (trié et avec valeur unique) inseré en UserForm VBA
2
Réponses
18
Affichages
436
Sghaier Chafaa
S
N
  • Question
Microsoft 365 Liste déroulante (combobox) en fonction d'une séquence de valeurs
Réponses
13
Affichages
269
Neofalken
N
L
  • Question
Microsoft 365 Userform : Combobox triée/sans doublons avec saisie intuitive/recherche multimots
Réponses
8
Affichages
2 K
AtTheOne
AtTheOne
M
  • Résolu(e)
Microsoft 365 Formulaire recherche qui plante - VBA
Réponses
3
Affichages
437
Mcmaldo
M
P
  • Résolu(e)
XL 2019 erreur 1024 ou 438 sur un Vlookup en vba
Réponses
5
Affichages
611
Liliv
L
A
  • Question
XL 2019 Récupérer les résultats d'une recherche de Google Maps ou Earth sur un tableau Excel
2
Réponses
20
Affichages
3 K
Pierred
P
S
  • Question
XL pour MAC [Mac - Excel - VBA] Problème de saisie semi-automatique dans une ComboBox
Réponses
9
Affichages
851
Shadufi
S
U
  • Résolu(e)
Autres Mettre en couleur ligne avec VBA car MFC occupées (Excel 2003)
2
Réponses
15
Affichages
1 K
un internaute
U

Membres actuellement en ligne

6 membres et 48 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 215
Messages
2 086 329
Membres
103 183
dernier inscrit
karelhu35