XL 2019 Trier une liste de noms latins en couleur sans doublons depuis une combobox d'un userform

L

lusert

XLDnaute Junior
Bonjour cher réseau,
J'ai mis en place à l'aide de quelques membres il y a quelques années une série de codes permettant d'utiliser un formulaire de saisies de nom d'espèces faune et flore.
Afin de faciliter la saisie pour les utilisateurs de la vielle école, j'intègre dans ma base de données ou liste de saisie des anciens noms qui sont en doublons.
J'aimerais lorsque que je saisie dans ma combobox un nom d'espèce de l'INPN, que ce dernier n'apparait pas 5 fois à la suite, mais 1 seule fois (exemple : a a b d e e e e devient a b d e).
J'ai essayé de m'inspirer de diverses macros présentées par M. Boisgontier sur son site, mais rien n'y fait il y toujours un code erreur. Je n'arrive pas à associer se trie sans doublon avec mon filtre de nom me permettant de saisi comme cela : ab al pour afficher abies alba et tous les autres noms comportant ab al.
Je vous joins mon fichier, vous verrez mieux mon problème. Il est possible que j'ai fais un mélange de plusieurs fonctions empêchant le bon déroulé des codes exemple de M.Boisgontier.

Le filtre sans doublon doit se faire que sur la combobox 1 (nom d'espèce ancien sur le formulaire) et apparait en colonne B sur la feuille choix. Le gestionnaire de nom comporte la formule référençant la plage de la liste à mettre sans doublon.

Merci d'avance pour votre temps et vos explications :)

Ps : le lien vers les exemples de liste sans doublons. J'ai deux autres soucis pour pouvoir conserver le texte en couleur et l'arrière plan en couleur de ma base de donnée vers la plage de saisie mais pareil, sous privat Sub j'ai su me débrouiller mais sous userform je bloque.
 

Pièces jointes

  • test_saisiesansdoublon.xlsm
    539.3 KB · Affichages: 10
Trier par date Trier par votes
L

lusert

XLDnaute Junior
yal à dit:
Bonjour
Si j'ai bien compris.
Cliquez pour agrandir...
Super merci à toi Yal 👍

C'est un début prometteur, merci. Je ne pensais pas que l'on pouvait mettre à la suite deux fois du Private Sub UserForm_Initialize().
Ça filtre parfaitement, je n'ai plus de doublon quand je regarde ma liste par contre quand je commence à saisir ab alb ou la seconde espèce la mise en forme sans doublon disparait et je me retrouve avec liste de choix affichant plusieurs fois le même nom. J'imagine que je dois fusionner nos deux Private Sub UserForm_Initialize() pour à la fois ne pas afficher les doublons et à la fois pouvoir saisir les noms par auto complétion réduite ( ex : ab al pour afficher abies alba).
Je vais essayer de chercher de mon côté comment fusionner ces deux privates Sub
 
Vote positif 0 Vote négatif
Y

yal

XLDnaute Occasionnel
Voila qui règle le problème. Remplacez l'acien Sub UserForm_Initialize() par celui ci :
VB: 
Private Sub UserForm_Initialize()
  Me.ComboBox1.Clear
  choix1 = Application.Transpose([Liste])
  Dim choix2
  Dim i!
  For i = 1 To UBound(choix1)
    If InStr(1, choix2, choix1(i)) = 0 Then choix2 = choix2 & "|" & choix1(i)
  Next i
  choix2 = Split(Right(choix2, Len(choix2) - 1), "|")
  choix1 = Application.Transpose(Application.Transpose(choix2))
  ComboBox1.SetFocus
  test1 = Application.Transpose([lb_nom_URL])
  Me.ComboBox1.List = choix1

End Sub
 
Vote positif 0 Vote négatif
L

lusert

XLDnaute Junior
yal à dit:
Voila qui règle le problème. Remplacez l'acien Sub UserForm_Initialize() par celui ci :
VB: 
Private Sub UserForm_Initialize()
  Me.ComboBox1.Clear
  choix1 = Application.Transpose([Liste])
  Dim choix2
  Dim i!
  For i = 1 To UBound(choix1)
    If InStr(1, choix2, choix1(i)) = 0 Then choix2 = choix2 & "|" & choix1(i)
  Next i
  choix2 = Split(Right(choix2, Len(choix2) - 1), "|")
  choix1 = Application.Transpose(Application.Transpose(choix2))
  ComboBox1.SetFocus
  test1 = Application.Transpose([lb_nom_URL])
  Me.ComboBox1.List = choix1

End Sub
Cliquez pour agrandir...
Magnifique :)
Merci pour tous 👍

Je vais prendre la soirée pour bien comprendre le sens de ton code. En tout cas tout semble fonctionner comme je le voulais, j'ai remplacé l'ancien Sub UserForm_Initialize() sur mon fichier d'origine contenant plus de 150000 lignes. Tout fonctionne pour le moment, je peux saisir et faire apparaitre les débuts de nom, les noms associés aux lettres saisies et aucuns noms en doublons n'est présent.
Je n'ai plus qu'à fouiller sur le net pour conserver la couleur de police et d'arrière plan et ce sera tout bon.
 
Vote positif 0 Vote négatif
L

lusert

XLDnaute Junior
Après une série de plusieurs essais, j'ai remarqué un souci dans la macro. J'ai ajouté la macro dans mon fichier d'origine ayant un code balise (pour mettre en italique le texte situé entre deux symboles). A chaque nouvelle saisie le texte s'affiche en italique et reboot les saisies précédente sans italique. cela ne le faisait pas avant ta macro, tu aurais une idée ? Qu'est-ce qui annule cela dans ton code d'après toi ?
 
Vote positif 0 Vote négatif
Y

yal

XLDnaute Occasionnel
Tu pourrais être plus clair? Parce que là je ne vois pas de quoi tu parles.
Peut être envoyer le fichier original avec seulement 500 ou 1000 lignes.
Dans la mesure ou je n'ai touché qu'l'initialisation du UserForm je ne vois pas ce qui dans mon code pourrait perturber la suite du traitement.
 
Vote positif 0 Vote négatif
L

lusert

XLDnaute Junior
yal à dit:
Tu pourrais être plus clair? Parce que là je ne vois pas de quoi tu parles.
Peut être envoyer le fichier original avec seulement 500 ou 1000 lignes.
Dans la mesure ou je n'ai touché qu'l'initialisation du UserForm je ne vois pas ce qui dans mon code pourrait perturber la suite du traitement.
Cliquez pour agrandir...
D'accord, je te transmets le fichier avec son code entier. Ce fichier, je l'espère sera mis un jour à disposition de qui veut, des naturalistes souhaitant se faciliter la vie lors de saisie d'espèce, ce jour arrivera peut être avec ton aide. Mon fichier doit comporter beaucoup d'erreur de syntaxe, de mauvaise formulation surement, et il lui manque un code de conservation de la couleur de texte et de cellule une fois écrit dans la plage de donnée A2: A50 de la feuille choix.

Pour revenir à nos moutons, voila je crois le code qui pose problème avec ta macro ou inversement :
Dim balise1$, balise2$, L1$, L2$, a$(), c As Range, n&, x$, sup%, i%, j%, k%, ss, s
balise1 = "<i>": balise2 = "</i>": L1 = Len(balise1): L2 = Len(balise2)

Application.ScreenUpdating = False
Cells.Font.Italic = False 'RAZ
With ActiveCell 'la feuille active est traitée
'---tableau des bornes---
ReDim a(1 To .Count)
For Each c In .Cells
n = n + 1
x = CStr(c)
sup = 0
For i = 1 To Len(x)
If Mid(x, i, L1) = balise1 Then
j = InStr(i + L1, x, balise2)
k = InStr(i + L1, x, balise1)
If k = 0 Then k = 32767
If j And j <= k Then
sup = sup + L1
a(n) = a(n) & " " & i - sup + L1 & "," & j - i - L1
sup = sup + L2
i = j + L2 - 1
End If
End If
Next i, c
'---effacement des 2 balises---
.Replace balise1, "", xlPart
.Replace balise2, ""
'---application des formats---
n = 0
For Each c In .Cells
n = n + 1
If a(n) <> "" Then
ss = Split(a(n))
For i = 1 To UBound(ss)
s = Split(ss(i), ",")
c.Characters(s(0), s(1)).Font.Italic = True
Next i
End If
Next c
End With
 

Pièces jointes

  • Copie de ListeIntuitiveFormulaireFilterInfo v1.xlsm
    527.3 KB · Affichages: 6
Vote positif 0 Vote négatif
L

lusert

XLDnaute Junior
yal à dit:
Dans le fichier que tu viens d'envoyer je ne vois nul part le code de ton message précédent. Je ne vois d'ailleurs pas de différence entre celui ci et le celui de ton post original
Cliquez pour agrandir...
il est situé dans Private Sub CommandButton1_Click().
Ci-dessous tu trouveras tout le code du fichier. Le code en rouge est celui qui pose problème depuis ta proposition de code sans doublon. Une référence dans un de ces deux codes ne doit pas se faire et s'annule !?

VB: 
Dim choix1()

Private Sub Label4_Click()

End Sub

Private Sub Label1_Click()

End Sub

Private Sub TextBox2_Change()

End Sub

Private Sub UserForm_Initialize()
  Me.ComboBox1.Clear
  choix1 = Application.Transpose([Liste])
  Dim choix2
  Dim i!
  For i = 1 To UBound(choix1)
    If InStr(1, choix2, choix1(i)) = 0 Then choix2 = choix2 & "|" & choix1(i)
  Next i
  choix2 = Split(Right(choix2, Len(choix2) - 1), "|")
  choix1 = Application.Transpose(Application.Transpose(choix2))
  ComboBox1.SetFocus
  test1 = Application.Transpose([lb_nom_URL])
  Me.ComboBox1.List = choix1

End Sub

Private Sub ComboBox1_Change()
  Dim Ind As Long, n As Long, Tt()
  If Me.ComboBox1.ListIndex = -1 And IsError(Application.Match(Me.ComboBox1, choix1, 0)) Then
   Me.ComboBox1.List = Filter(choix1, Me.ComboBox1.Text, True, vbTextCompare)
   If Me.ComboBox1 <> "" Then
     mots = Split(Trim(Me.ComboBox1), " ")     ' divise puis réduit la combobox
     Tbl = choix1
     For i = LBound(mots) To UBound(mots)
       Tbl = Filter(Tbl, mots(i), True, vbTextCompare)
     Next i
        Me.ComboBox1.List = Tbl
   Me.ComboBox1.DropDown
      End If
       Me.TextBox1 = ""
 Me.TextBox2 = ""
 Me.TextBox3 = ""
 Else
    P = Application.Match(Me.ComboBox1, choix1, 0)
    Me.TextBox1 = Range("info")(P)
    P = Application.Match(Me.ComboBox1, choix1, 0)
    Me.TextBox3 = Range("ZH")(P)
    P = Application.Match(Me.ComboBox1, choix1, 0)
    Me.TextBox2 = Range("lb_nom_URL")(P)
 End If
End Sub
  Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = 13 Then CommandButton1_Click
        If KeyCode = 38 Or KeyCode = 40 Then FlgExit = True

    End Sub
   
Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
 ComboBox1.ListIndex = -1
        Me.ComboBox1.List = choix1
        End Sub

 
Private Sub CommandButton1_Click()
      tmp = Me.ComboBox1
  If IsNumeric(tmp) Then tmp = CDbl(tmp)
   ActiveCell.Offset(, 1) = tmp
  ActiveCell.Offset(, 2) = Me.TextBox1
   ActiveCell = Me.TextBox2
   ActiveCell.Font.Name = "Arial"
 ActiveCell.Font.Size = 10
 ActiveCell.Font.Bold = False
ActiveCell.Font.Italic = False
 ActiveCell.Font.Underline = False
  Unload Me
  Application.OnKey "{ENTER}", "valider"
   [COLOR=rgb(226, 80, 65)]   Dim balise1$, balise2$, L1$, L2$, a$(), c As Range, n&, x$, sup%, i%, j%, k%, ss, s
balise1 = "<i>": balise2 = "</i>": L1 = Len(balise1): L2 = Len(balise2)

Application.ScreenUpdating = False
Cells.Font.Italic = False 'RAZ
With ActiveCell 'la feuille active est traitée
    '---tableau des bornes---
       ReDim a(1 To .Count)
    For Each c In .Cells
        n = n + 1
        x = CStr(c)
        sup = 0
        For i = 1 To Len(x)
            If Mid(x, i, L1) = balise1 Then
                j = InStr(i + L1, x, balise2)
                k = InStr(i + L1, x, balise1)
                If k = 0 Then k = 32767
                If j And j <= k Then
                    sup = sup + L1
                    a(n) = a(n) & " " & i - sup + L1 & "," & j - i - L1
                    sup = sup + L2
                    i = j + L2 - 1
                End If
            End If
    Next i, c
    '---effacement des 2 balises---
    .Replace balise1, "", xlPart
    .Replace balise2, ""
    '---application des formats---
    n = 0
    For Each c In .Cells
        n = n + 1
        If a(n) <> "" Then
            ss = Split(a(n))
            For i = 1 To UBound(ss)
                s = Split(ss(i), ",")
                c.Characters(s(0), s(1)).Font.Italic = True
            Next i
        End If
    Next c
End With[/COLOR]
  If Me.ComboBox1 <> "" Then 'Si la zone de saisie de la combobox comporte un de ces mots alors il sera sans italic
 mot = " subsp. "
  For Each c In ActiveCell
   P = InStr(UCase(c), UCase(mot))
   If P > 0 Then c.Characters(Start:=P, Length:=Len(mot)).Font.Italic = False 'Valeur italique fausse, donc Subsp ecrit sans italic
  Next c
  mot2 = " var. "
  For Each c In ActiveCell
   P = InStr(UCase(c), UCase(mot2))
   If P > 0 Then c.Characters(Start:=P, Length:=Len(mot2)).Font.Italic = False
  Next c
  mot3 = " sp. "
  For Each c In ActiveCell
   P = InStr(UCase(c), UCase(mot3))
   If P > 0 Then c.Characters(Start:=P, Length:=Len(mot3)).Font.Italic = False
  Next c
  mot3 = " x "
  For Each c In ActiveCell
   P = InStr(UCase(c), UCase(mot3))
   If P > 0 Then c.Characters(Start:=P, Length:=Len(mot3)).Font.Italic = False
    Next c
  mot3 = "+ "
  For Each c In ActiveCell
   P = InStr(UCase(c), UCase(mot3))
   If P > 0 Then c.Characters(Start:=P, Length:=Len(mot3)).Font.Italic = False
   Next c
  End If

End Sub
1642608565792.png


1642608589318.png


Voila ce qui se passe à chaque nouvelle saisie le texte mise en forme en italique n'est plus en italique alors qu'à la saisie précédente il est en italique. La saisie suivante annule l'italique du nom écrit 1 minute avant.
 
Vote positif 0 Vote négatif
L

lusert

XLDnaute Junior
yal à dit:
Voilà une version améliorée qui semble répondre aux besoins mise à part l'histoire de la couleur que je n'ai pas comprise.
Cliquez pour agrandir...
Superbe amélioration que tu viens de me proposer, certains codes tel que les balises était super long, Je trouve génial les possibilités qu'offre le VBA.
Je vais faire quelque essais de mon côté, mais je crois que tu viens de m'enlever une grosse épine du pied. Toute semble fonctionner à merveille comme je le voulais. Il ne reste plus que cette histoire de couleur et ce fichier sera tip top pour une utilisation public.
 
Vote positif 0 Vote négatif
L

lusert

XLDnaute Junior
Pour l'histoire des couleurs, c'est plus simple en privat Sub mais incompréhensible en userform j'ai remarqué... Tu as pu constater dans la feuille BD mes noms d'espèces sont en couleurs rouges, noir, bleu, etc. et certains noms d'espèces sont surlignés en différentes couleurs. J'aimerais que dans la feuille Choix que les noms d'espèces qui l'on peut écrire conserve la même couleur présente en BD.
Voici un exemple de rendu en couleur en privat sub combobox . Mes noms d'espèces conserve la même couleur identique de ma base de donnée BD.
1642627154466.png

1642627258104.png
 
Vote positif 0 Vote négatif

Discussions similaires

L
  • Question
Microsoft 365 Userform : Combobox triée/sans doublons avec saisie intuitive/recherche multimots
Réponses
8
Affichages
2 K
AtTheOne
AtTheOne
L
  • Question
XL 2019 Conserver la mise en forme texte (couleur /remplissage) lors de la saisie en userform
Réponses
4
Affichages
2 K
lusert
L
J
  • Question
XL 2016 Mise en forme conditionnelle en vert de noms, si ces noms figurent dans une liste de noms d'un autre onglet (formules dans MFormCond, ou VBA)
Réponses
5
Affichages
888
sylvanu
sylvanu
L
  • Question
XL 2019 Comment réaliser une saisie intuitive type (ab ab = Abies alba) et qui garde la mise en forme couleur de la BD sous userform
Réponses
3
Affichages
1 K
lusert
L
S
  • Question
XL pour MAC [Mac - Excel - VBA] Problème de saisie semi-automatique dans une ComboBox
Réponses
9
Affichages
983
Shadufi
S
P
  • Question
Microsoft 365 Valeur dans liste déroulante passe à la suivante automatiquement - Userform VBA
Réponses
1
Affichages
1 K
Dranreb
Dranreb
B
  • Résolu(e)
XL 2016 Créer une liste déroulante de noms selon ComboBox ou listbox avec nom+prénom
Réponses
8
Affichages
1 K
berru76
B
L
  • Question
XL 2019 Saisie naturaliste basée sur code private sub de liste intuitive
2
Réponses
19
Affichages
3 K
lusert
L
Virginie17d
  • Résolu(e)
XL 2010 UserForm, menu déroulant cascade et enrichir une base de donnée
2 3 4
Réponses
53
Affichages
7 K
ChTi160
ChTi160
E
  • Question
Autres Modifier le contenu d'un tableau en fonction du choix dans une liste déroulante
Réponses
5
Affichages
3 K
EnoraD
E

Membres actuellement en ligne

2 membres et 46 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
315 087
Messages
2 116 084
Membres
112 655
dernier inscrit
fannycordi