Microsoft 365 Liste validation grace aux premières lettres

  • Initiateur de la discussion Initiateur de la discussion Claudy
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Claudy

XLDnaute Accro
Bonjour,
Est il possible de valider une donnée sans passer par l'outil "Validation de données", mais simplement valider une proposition avec les premières lettres.
La liste se trouverait en A1:A100.
Ok pour VBA
Merci,

Claudy
 
Mettez cette macro dans le code de la feuille et adaptez la plage "cible" :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim liste As Range, cible As Range, d As Object, c As Range, tablo, ub&, i&, j%, x$, k%
Set liste = [A1:A100] 'à adapter
Set cible = [B2:D65000] 'à adapter
Set Target = Intersect(Target, cible, UsedRange)
If Target Is Nothing Then Exit Sub
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
For Each c In liste
    d(c.Value) = ""
Next c
Application.EnableEvents = False
For Each Target In Target.Areas 'si entrées ou effacements multiples
    tablo = Target.Resize(, Target.Columns.Count + 1) 'matrice, plus rapide, au moins 2 éléments
    ub = UBound(tablo, 2) - 1
    For i = 1 To UBound(tablo)
        For j = 1 To ub
            x = tablo(i, j)
            If x <> "" Then
                For k = 1 To Len(x)
                    If d.exists(Left(x, k)) Then GoTo 1
                Next k
                tablo(i, j) = "Rien"
1           End If
    Next j, i
    Target = tablo
Next Target
Application.EnableEvents = True
End Sub
Edit : avec la copie de B2: D65000 sur elle-même la macro s'exécute en 0,7 seconde.
 

Pièces jointes

Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
11
Affichages
251
Réponses
22
Affichages
1 K
Réponses
3
Affichages
705
Retour