XL 2013 code vba pour remplissage automatique

[louane2022]

Bonjour,
je souhaite savoir quel code VBA pour remplissage instantané selon des mots clés.

 

[mapomme]

Bonjour @louane2022 🙂,

Avec une formule. La formule suivante en C2 à copier vers le bas donne le bon résultat :

=SUPPRESPACE(DROITE(SUBSTITUE(A2;" ";REPT(" ";255));255))

 

[louane2022]

Bonjour @louane2022 🙂,

Avec une formule. La formule suivante en C2 à copier vers le bas donne le bon résultat :

=SUPPRESPACE(DROITE(SUBSTITUE(A2;" ";REPT(" ";255));255))

ça a marché , sauf pour la cellule A5

 

[job75]

Bonjour louane2022, mapomme,

Voyez le fichier joint et cette fonction VBA :

Function Extract$(x$, matrice)
Dim s, ub%, i%
s = Split(Application.Trim(x))
ub = UBound(s)
For i = 0 To ub
    If IsNumeric(Application.Match(s(i), matrice, 0)) Then
        If i < ub Then Extract = s(i + 1)
        Exit For
    End If
Next
End Function

Le code doit être placé impérativement dans un module standard.

Formule en C2 à tirer vers le bas =Extract(A2;{"FAV.";"VERS";"CB"})

La matrice {"FAV.";"VERS";"CB"} contient 3 mots clés.

A+

 

[job75]

Une solution nettement plus rapide grâce au Dictionary dans ce fichier (2) :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim d As Object, matrice, i&, tablo, resu(), s, ub%, j%
'---mémorisation---
Set d = CreateObject("Scripting.Dictionary")
matrice = Array("FAV.", "VERS", "CB") 'modifiable
For i = 0 To UBound(matrice): d(matrice(i)) = "": Next i
'---tableau des résultats---
tablo = [A1].CurrentRegion.Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
ReDim resu(1 To UBound(tablo), 1 To 1)
For i = 2 To UBound(tablo)
    s = Split(Application.Trim(tablo(i, 1)))
    ub = UBound(s)
    For j = 0 To ub
        If d.exists(s(j)) Then
            If j < ub Then resu(i, 1) = s(j + 1)
            Exit For
        End If
Next j, i
'---restitution---
Application.EnableEvents = False 'désactive les évènements
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [C1] '1ère cellule de destination
    resu(1, 1) = .Value
    .Resize(i - 1) = resu
    .Offset(i - 1).Resize(Rows.Count - i - .Row + 2).ClearContents  'RAZ en dessous
End With
Application.EnableEvents = True 'réactive les évènements
End Sub

La macro est placée dans le code de la feuille et se déclenche quand une cellule quelconque est modifiée.

Testé en recopiant le tableau A2:A9 sur 50 000 lignes :

- recalcul des fonctions du post #4 => 2,2 secondes

- cette macro => 0,6 seconde chez moi sur Win 11 Excel 2019.