XL 2016 Extraire plusieurs chaînes de caractères d'une même cellule

[Mam's]

Bonjour à tous,

J'ai une cellule A2 avec une très longue chaine de caractères.
Dans les colonnes B, C, D... je souhaite reporter de A2 les différentes chaînes de caractère commençant par FM. Il peut y en avoir une seule, mais il peut aussi y en avoir 5, 6...
Je peux avoir plusieurs fois la même référence commençant par FM, je voudrai qu'elle n'apparaisse qu'une seule fois.
Dans l'idéal, en glissant la formule jusqu'au bout de la liste, j'aimerai que la cellule devienne vide lorsque j'ai épuisé toutes les "FM" présentes en A2.
Je joins un petit fichier, avec quelques essais de formules. Mon fichier de travail est sur 800 lignes environ.

Pouvez-vous m'aider ?

Merci beaucoup.

Mam's

 

[Eric KERGRESSE]

Bonjour,

A tester :

Sub ImportFm()

  With ActiveSheet
    ChargerLaListeDesFM .Range("A2:A800")
  End With

End Sub


Sub ChargerLaListeDesFM(ByVal AireFM As Range)

Dim I As Integer, J As Integer, K As Integer
Dim ListeFm As Object
Dim Fm As String
Dim ListeCles As Variant, TabFm As Variant, Temp1 As Variant

    Range(AireFM.Offset(0, 1), AireFM.Offset(0, 9)).ClearContents

    For K = 1 To AireFM.Count
          
        TabFm = Split(AireFM(K), "FM")
        Temp1 = ""
        Set ListeFm = CreateObject("Scripting.Dictionary")

        For I = LBound(TabFm) To UBound(TabFm)
            Select Case Mid(TabFm(I), 1, 1)
                   Case 0 To 9
                        Fm = "FM" & Mid(TabFm(I), 1, 5)
                        If Not ListeFm.Exists(Fm) Then ListeFm.Add Fm, Fm
            End Select
        Next I
            
        ListeCles = ListeFm.keys
                      
        ' Tri des FM par ordre alphabétique
        '----------------------------------
        For I = LBound(ListeCles) To UBound(ListeCles) - 1
                For J = I + 1 To UBound(ListeCles)
                    If ListeCles(I) > ListeCles(J) Then
                       Temp1 = ListeCles(I)
                       ListeCles(I) = ListeCles(J)
                       ListeCles(J) = Temp1
                     End If
                Next J
        Next I
          
        ' Mise à jour du tableau
        '-----------------------
        For I = LBound(ListeCles) To UBound(ListeCles)
            If ListeCles(I) <> "" Then AireFM(K).Offset(0, I + 1) = ListeCles(I)
        Next I
        
        Erase ListeCles
        Set ListeFm = Nothing
            
    Next K
    
    Set ListeFm = Nothing

End Sub

 

[mapomme]

Bonjour @Mam's , @Eric KERGRESSE ,

Avec une fonction personnalisée : = niemeFM(x , rang) en VBA ou = niemeFM(x ; rang) sur une feuille de calcul où :

• x est le texte où chercher les termes en FM
• rang est l'index du terme en FM à retourner (rang=1 pour le premier, rang=2 pour le deuxième, etc)

Sur la feuille de calcul, voir la formule en B2 à recopier vers la droite et vers le bas.
Rang a été mis à COLONNES($A:A) qui va donner les nombres 1, 2, 3, ... quand on copie la formule vers la droite.

Le code est dans module1:

Function niemeFM$(ByVal x$, rang&)
Dim s, n&, num, i&, suff, c$, nombre As Boolean
   s = Split("/" & x, "FM")
   For Each num In s
      nombre = False: suff = ""
      For i = 1 To Len(num)
         c = Mid(num, i, 1)
         If c Like "#" Then
            nombre = True
            suff = suff & c
         Else
            Exit For
         End If
      Next i
      If nombre Then n = n + 1: If n = rang Then niemeFM = "FM" & suff: Exit Function
   Next num
End Function

 

[Mam's]

@Eric KERGRESSE
Merci pour ce retour. Je n'ai pas précisé mais je recherche plutôt une solution par formule plutôt que par code, déjà parce que je ne maitrise pas du tout, mais aussi parce que les autres personnes qui devront utiliser ce fichier ne maitrisent pas non plus... je garde tout de même l'info, au cas où

@mapomme
En testant la formule dans mon fichier test, tout va bien, mais quand j'essaie dans mon grand fichier, j'obtiens une erreur #NOM?
D'où peut venir le problème ?

 

[mapomme]

@mapomme
En testant la formule dans mon fichier test, tout va bien, mais quand j'essaie dans mon grand fichier, j'obtiens une erreur #NOM?
D'où peut venir le problème ?

Sans doute que vous n'avez pas reporté le code de la macro dans le gros classeur donc Excel ne connait pas "niemeFM".

 

[mapomme]

Re,

Pour importer le code dans un classeur où vous désirez utiliser la fonction niemeFM :

• sauvegarder le fichier contenu dans le fichier .zip joint sur votre disque (fichier mod_niemeFM.bas). Sauvegarder le bien avec l'extension .bas
• puis ouvrez le classeur où vous désirez utiliser la fonction niemeFM
• et suivez les instruction ci-dessous :

• à ce stade, le code de la fonction a été intégré au classeur
• vous devriez normalement pour voir utiliser la fonction niemeFM et ne plus voir #NOM?

 

[Eric KERGRESSE]

Au cas où

La macro se lance avec le bouton vert dans la barre d'accès rapide.

 

[Mam's]

Ok, pardon, je n'avais pas compris qu'il fallait du code + la formule...
Comme je disais à @Eric KERGRESSE je préfère ne pas utiliser de macro. J'ai testé tout de même et ça fonctionne très bien. Juste une petite remarque : si j'ai plusieurs fois la même réf, chaque occurrence apparaît. Est-t-il possible de corriger ça ?

 

[Mam's]

S'il existe une solution sans macro, cela m'intéresse.
Quelqu'un aurait-il une idée ?

 

[mapomme]

si j'ai plusieurs fois la même réf, chaque occurrence apparaît. Est-t-il possible de corriger ça ?

Oui mais c'est un peu plus plus compliqué... (j'y réfléchis et je reviens)
La méthode @Eric KERGRESSE le fait déjà (et en plus il les classe du plus petit au plus grand)

 

[JHA]

Bonjour à tous,

Un début avec la fonction substitue.

JHA

 

[patricktoulon]

Bonjour Bonjour
j'arrive après la bataille mais bon
voici ma proposition
une fonction perso qui va te stocker dans un array
et te le redimer a la fin aux nombres de cellules qui ont la formule (pour eviter les N#A)
la fonction à mettre dans un module standard

Function GetChaineFM(cel As String)
     Dim t$(), I&, A&
    I = InStr(1, cel, "FM")
    Do Until I = 0
        cx = Mid(cel, I, Len(cel)) 'on coupe à "FM"
        cx = Mid(cx, 1, InStr(1, cx, " ")) 'on coupe au premier espaced de la coupe précédente
        A = A + 1: ReDim Preserve t(1 To A): t(A) = cx 'on stock
        I = InStr(I + 1, cel, "FM") 'on avance le i de 1 pour passer ausuivant
    Loop
      ReDim Preserve t(1 To Application.Caller.Columns.Count) 'on redimpreserve au nombre de cellules ayant la formule en matricielle
    GetChaineFM = t
End Function

et la formule tu la valide en matricielle sur tout la plage en même temps dans la barre de formule

enjoy !

 

[mapomme]

Re,

Voici une nouvelle version de la fonction nommée extractFM$( x , rang , tri) pour du code VBA
et extractFM$( x ; rang ; tri) sur une feuille de calcul Excel.

1. le premier paramètre est le texte à analyser
2. le second paramètre est le rang du terme "FM" à extraire
3. le troisième paramètre tri est optionnel (présent ou absent). S'il est absent, les résultats ne sont pas triés et on affiche les termes FM dans l'ordre de leur apparition dans le texte à analyser. S'il est présent (est égal à n'importe quoi), les termes FM sont triés en fonction de la valeur du nombre présent les termes FM

=extractFM$( A2 ; 3) on ne trie pas | =extractFM$( A2 ; 3 ; 1) on trie


remarque : les doublons sont retirés des résultats que ce soit avec tri ou sans tri.


Les fichiers joints :

1. Mam's- extraction string- v2.xlsm : c'est le classeur démo
2. mod_extractFM.zip : c'est le fichier contenant le code de la fonction mod_extractFM.bas. La manip pour l'intégrer dans le classeur de votre choix est analogue à celle du message #6.

 

[patricktoulon]

re
pardon j'avais zappé la suppression de doublons

Function GetChaineFM(cel As String, Optional MatricalCell As Boolean = True)
     Dim t$(), I&, A&
    I = InStr(1, cel, "FM")
    Do Until I = 0
        cx = Mid(cel, I, Len(cel)) 'on coupe à "FM"
        cx = Mid(cx, 1, InStr(1, cx, " ")) 'on coupe au premier espaced de la coupe précédente
       If Not " " & Join(t, " ") & " " Like "*" & cx & "*" Then A = A + 1: ReDim Preserve t(1 To A): t(A) = cx 'on stock
        I = InStr(I + 1, cel, "FM") 'on avance le i de 1 pour passer ausuivant
    Loop
      ReDim Preserve t(1 To Application.Caller.Columns.Count) 'on redimpreserve au nombre de cellules ayant la formule en matricielle
    GetChaineFM = t
End Function

 

[Mam's]

Bonjour,

Merci à tous pour vos retours. Je pars en congés, je verrai ça à mon retour et je vous dirai la solution qui aura été adoptée.

Bonnes fêtes de fin d'année