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

[lusert]

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.

Listes sans doublons triée

 

[yal]

Ben non je n'ai rien constaté. Dans les fichiers que pu as partagés dans la feuille BD tout est est texte rouge sur fond jaune. Il n'y a pas d'autre couleur. Je n'ai trouvé nulle part de code pour gérer des couleurs. Alors je ne comprends toujours pas.

 

[lusert]

Sur le site boisgontierj.free j'avais à l'époque pu m'inspirer d'un code me permettant de conserver les couleurs de mon texte comme illustré en capture d'écran.
Je m'étais inspiré de ce code ci-dessous

'Choix dans un combobox avec saisie intuitive caractère par caractère

'et conservation de la mise en forme du texte après saisie

'Cliquer dans la cellule et frapper les premières lettres

Dim a(), mémo, f, zsaisie

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Set f = Sheets("bd")

Set zsaisie = Range("A2:A16")

[COLOR=rgb(226, 80, 65)]If Not Intersect(zsaisie, Target) Is Nothing And Target.Count = 1 Then

If mémo <> "" Then If IsError(Application.Match(Range(mémo), a, 0)) Then Range(mémo) = ""

Set Rng = f.Range("a2:a" & f.[A65000].End(xlUp).Row)

ActiveWorkbook.Names.Add Name:="Liste", RefersTo:=Rng

a = Application.Transpose(f.Range("a2:a" & f.[A65000].End(xlUp).Row))[/COLOR]

Me.ComboBox1.List = a

Me.ComboBox1.Height = Target.Height + 3

Me.ComboBox1.Width = Target.Width

Me.ComboBox1.Top = Target.Top

Me.ComboBox1.Left = Target.Left

Me.ComboBox1 = Target

Me.ComboBox1.Visible = True

Me.ComboBox1.Activate

mémo = Target.Address

Else

Me.ComboBox1.Visible = False

End If

End Sub

Private Sub ComboBox1_Change()

If Me.ComboBox1 <> "" And IsError(Application.Match(Me.ComboBox1, a, 0)) Then

Set d1 = CreateObject("Scripting.Dictionary")

tmp = UCase(Me.ComboBox1) & "*"

For Each c In a

If UCase(c) Like tmp Then d1(c) = ""

Next c

Me.ComboBox1.List = d1.keys

Me.ComboBox1.DropDown

End If

ActiveCell.Value = Me.ComboBox1

End Sub

Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

ComboBox1.List = Application.Transpose(f.Range("a2:a" & f.[A65000].End(xlUp).Row))

Me.ComboBox1.DropDown

End Sub

Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

If KeyCode = 13 Then

If IsError(Application.Match(ActiveCell, a, 0)) Then ActiveCell = ""

ActiveCell.Offset(1).Select

End If

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

[COLOR=rgb(226, 80, 65)]If Not Intersect([zsaisie], Target) Is Nothing Then

Application.EnableEvents = False

On Error Resume Next

[Liste].Find(Target, LookAt:=xlWhole).Copy Target

Application.EnableEvents = True

End If[/COLOR]

End Sub

'http://boisgontierjacques.free.fr

'Liste=BD!$A$2:$A$14907

Il fonctionne bien, les noms d'espèces visible dans la feuille de saisie sont de la même couleur que la BD.
Les codes en couleurs sont pour moi les codes permettant de conserver le texte couleur de la bd.

 

[yal]

Ca y est j'ai compris, enfin je crois.
C'est normal que ça ne marche pas Il y a une totale incompatibilité entre les deux approches. On ne peut pas avoir une liste sans doublons et la couleur. Du moins pas de cette façon. Si la couleur dépend du texte (un même texte est toujours de la même couleur) dans la bd, on peut s'en sortir. Par contre si c'est lié à l'adresse de la cellule?

 

[lusert]

Ca y est j'ai compris, enfin je crois.
C'est normal que ça ne marche pas Il y a une totale incompatibilité entre les deux approches. On ne peut pas avoir une liste sans doublons et la couleur. Du moins pas de cette façon. Si la couleur dépend du texte (un même texte est toujours de la même couleur) dans la bd, on peut s'en sortir. Par contre si c'est lié à l'adresse de la cellule?

Oui C'est ce que j'essayais de dire... Bon super que tu vois ce que je veux faire. Mon code de départ se base en effet sur la BD, mais je n'ai pas su l'adapter sous userform pour que la couleur dépend du texte de la BD. J'ai constasté qu'il y a une histoire de code transpose color et RGB mais de mon côté ça plante à chaque fois.

Par adresse cellule tu parles que la couleur soit afficher dans la case de la combobox? Il me semble que ce soit possible cette dernière que sous listbox (de ce que j'ai lu en forum).

 

[yal]

Non je parle des couleurs (fond et texte) dans la cellule dans la feuille bd. Avec un Find on peut trouver l'adresse d'une cellule contenant ce texte et récupérer les couleurs de la dite cellule

 

[lusert]

Non je parle des couleurs (fond et texte) dans la cellule dans la feuille bd. Avec un Find on peut trouver l'adresse d'une cellule contenant ce texte et récupérer les couleurs de la dite cellule

C'est une bonne idée On voit ce que ça pourrait donner.

 

[yal]

Je veux bien mais il faudrait me dire quel texte (colonne A, B, C...) et dans quelle colonne de la feuille "BD" il faut chercher.
Ca serait franchement plus simple si tu m'envoyais le vrai fichier

 

[lusert]

Je veux bien mais il faudrait me dire quel texte (colonne A, B, C...) et dans quelle colonne de la feuille "BD" il faut chercher.
Ca serait franchement plus simple si tu m'envoyais le vrai fichier

La colonne A de feuille Choix est celle qui comporte la plage de saisie en A2: A50 où le texte doit apparaitre. La colonne T de la BD est celle servant de liste déroulante à la combobox. Actuellement le texte de la BD est en rouge et souligné en jaune (je n'ai pas pensé pour l'exemple de colorier cette dizaine de ligne en couleurs différentes) mais sur les 125 000 lignes le texte est de couleurs différentes.

 

[yal]

Voila une version avec de la couleur. Je n'ai pas pu faire de tests approfondis vu le fichier dont je dispose. Je doute un peu que cela fonctionne vraiment.

 

[lusert]

Voila une version avec de la couleur. Je n'ai pas pu faire de tests approfondis vu le fichier dont je dispose. Je doute un peu que cela fonctionne vraiment.

Merci pour tes solutions, c'est chouette
Alors j'ai fais plusieurs essais. J'ai tranformé ton code et fichier (ci-dessous) pour supprimer 3 effets bizarres qui dupliqué la couleur sur des cellules de la BD. Maintenant les couleurs semblent bien apparaître.
Pourquoi ne peut-on pas intégrer le code dans l'userform ?

Option Explicit

Sub EnCouleur()
  Dim rng As Range
  Set rng = Sheets("BD").Range("T:T").Find(What:=ActiveCell.Value2, LookAt:=xlPart)
   ActiveCell.Interior.Color = rng.Interior.Color
   ActiveCell.Font.Color = rng.Font.Color
 
End Sub

 

[yal]

Tu peux toujours essayer. Tu colles le code de la macro "EnCouleur" à la place du "call EnCouleur".
Personnellement je préfère ne mettre dans le UserForm que ce qui le concerne directement ça rend le code plus lisible et plus simple à maintenir. Mais ce n'est que mon avis.

 

[lusert]

Tu peux toujours essayer. Tu colles le code de la macro "EnCouleur" à la place du "call EnCouleur".
Personnellement je préfère ne mettre dans le UserForm que ce qui le concerne directement ça rend le code plus lisible et plus simple à maintenir. Mais ce n'est que mon avis.

Alors dans ce cas je vais suivre ton conseil, je suis encore débutant pour ces aspects-là.
Je regarde d'ici demain s'il y a des erreurs de codes qui apparaissent, mais pour le moment tout semble fonctionner à merveille.

 

[lusert]

Je viens de constater une erreur dans le code des balises.

<i>Abies lasiocarpa </i>var.<i> arizonica</i> (Merriam) Lemmon, 1982

Abies lasiocarpa var. arizonica (Merriam) Lemmon, 1982 = mise en forme de nom latin non correct Abies lasiocarpa var. arizonica (Merriam) Lemmon, 1982 = mise en forme de nom latin correct

le texte entre les deux balises n'apparait pas en italique (en orange) alors que le texte entre les deux premières balises si ( en violet). Je n'ai pas trouvé la solution, tu aurais une idée ?

J'ai tenté de m'inspirer de mon acien code ci-desous
Sub Italique()
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 ActiveSheet.UsedRange '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
End Sub

 

[yal]

Une dernière proposition. Pour la récupération de la couleur j'ai trouvé beaucoup plus simple et efficace. On la récupère dans la procédure "Private Sub ComboBox1_Change()" et on la traite dans "CommandButton1_Click()".
D'autre part pour régler la mise en forme des textes. J'ai ajouté une colonne dans la feuille "Choix" et je sépare les deux parties du texte. En colonne 1 le texte en italique, en colonne 2 le reste du texte. Comme je n'ai aucune idée de ce à quoi servent ces textes je ne sais pas si c'est judicieux.
Je dis une "dernière proposition" parce que je suis las de bosser sur un fichier qui ne reflète pas la réalité et que donc je jette l'éponge.
J'espère t'avoir été un peu utile.
Cordialement

 

[lusert]

Une dernière proposition. Pour la récupération de la couleur j'ai trouvé beaucoup plus simple et efficace. On la récupère dans la procédure "Private Sub ComboBox1_Change()" et on la traite dans "CommandButton1_Click()".
D'autre part pour régler la mise en forme des textes. J'ai ajouté une colonne dans la feuille "Choix" et je sépare les deux parties du texte. En colonne 1 le texte en italique, en colonne 2 le reste du texte. Comme je n'ai aucune idée de ce à quoi servent ces textes je ne sais pas si c'est judicieux.
Je dis une "dernière proposition" parce que je suis las de bosser sur un fichier qui ne reflète pas la réalité et que donc je jette l'éponge.
J'espère t'avoir été un peu utile.
Cordialement

Je comprends tout à fait ton choix. Tu m'as déjà apporté beaucoup d'info. J'ai là une belle mise à jour de mon fichier de saisie d'espèce. Je vais rester sur la V5 ou la v6. Peut-être plus sur la V6 pour la réduction de la taille de la macro. L'histoire des balises je vais devoir essayer de l'améliorer en me basant sur la V5 car en V6 le nom d'espèces est éparpillé (un bout en colonne A et un bout en colonne B ) sur 2 cellules. Il est difficile de représenter une BD correspondant à la réalité de la BD d'origine mais l'information à faire apparaître y était. J'ai remarqué d'ailleurs que la conservation de la couleur marchait quand on surlignait toute la ligne de la même couleur. Je saurais maintenant que dans la BD d'origine il faut faire pareil.
Je me rencontre que le fichier arrive bientôt à sa VF (même si il y a toujours possibilité d'améliorer comme tout). Je créerais surement une file de discussion basée uniquement sur l'amélioration du fichier en tant que tel pour ainsi permettra l'accès à un fichier tout propre disponible à qui veut