XL 2016 Compter le nombre de mots entre [ ] dans une chaîne de caractères

[Aeser]

Bonjour,

J’ai dans ma colonne A des textes contenant pour certains des expressions entre [ ] et je souhaiterais calculer le nombre total de mots entre [ ] par cellule.

Le nombre d’expressions entre [ ] par cellule est variable, de même que le nombre de mots entre [ ] au sein d’une même expression. Et c’est là toute la difficulté…

Je sais calculer le nombre d’expressions entre [ ] par cellule, mais je bloque pour le nombre de mots entre [ ]...

Des suggestions ?

Vous trouverez-ci-joint le fichier d'exemple

Merci pour votre aide

 

[mapomme]

Bonsoir @Aeser,
Bienvenue sur XLD ,

Avec une fonction personnalisée Mots (voir colonne D) dont le code VBA est dans module1 :

Function Mots(x As String) As Long
Dim s, n&, c
   x = Replace(x, "[", "µ["): x = Replace(x, "]", "]µ")
   s = Split(Application.Trim(x), "µ")
   For Each c In s: n = n + IIf(Left(c, 1) = "[", UBound(Split(c)) + 1, 0): Next
   Mots = n
End Function

 

[patricktoulon]

re
bonsoir
on peut peut être zapper le replace
et en bouclant a partir de 1 le split donnant un array en base 0 la partie avant le premier est zapé

Sub testx()
Dim x
x = "dgfdgf[jhgjhg ghgh fhgfg]ghjghghpopoidfd[gfgfdd hfg]hnjhjfgf[fgdfrs]hjhgjg ghghgh gfgfgfg"
t = Split(x, "[")
For i = 1 To UBound(t): c = c + UBound(Split(Split(t(i), "]")(0), " ")) + 1: Next
MsgBox c
End Sub

 

[Dudu2]

Bonsoir les chercheurs de mots,

Sub a()
    MsgBox NbMots("zdfzef [ efzefzae    erzer  zd ze   zeer    ] zeze erev")
End Sub

Function NbMots(ByVal Chaine As String) As Integer
    Dim t() As String
    Dim i As Integer
  
    Chaine = Replace(Chaine, "]", "[")
    t = Split(Split(Chaine, "[")(1), " ")
    For i = LBound(t) To UBound(t)
        If Len(Trim(t(i))) Then NbMots = NbMots + 1
    Next i
End Function

 

[patricktoulon]

Dudu2
surtout pas ton replace
c'est pas cohérent avec x portions
ajoute plusieurs portions [.... .... ...] dans ta chaîne de départ tu verra
et je parle même pas des sub portions potentielle[.... ....[..... ..... .....].... .....] qui n'a pas été envisagé dans tout ce poste

 

[Dudu2]

En effet, j'ai vu ça. En fait je ne sais pas si la demande s'applique à 1 séquence de [...] ou à plusieurs.

 

[Dudu2]

Si c'est toutes les séquences alors cette version,...

- Si toujours 1 seul espace entre les mots et pas d'espace après '[' ni avant ']'

Function NbMots(ByVal Chaine As String) As Integer
    Dim t() As String
    Dim i As Integer
    Dim j As Integer

    Chaine = Replace(Chaine, "]", "[")
    For i = 1 To UBound(Split(Chaine, "[")) Step 2
        t = Split(Split(Chaine, "[")(i), " ")
        NbMots = NbMots + UBound(t) + 1
    Next i
End Function

-Sinon

Function NbMots(ByVal Chaine As String) As Integer
    Dim t() As String
    Dim i As Integer
    Dim j As Integer

    Chaine = Replace(Chaine, "]", "[")
    For i = 1 To UBound(Split(Chaine, "[")) Step 2
        t = Split(Split(Chaine, "[")(i), " ")
        For j = LBound(t) To UBound(t)
            If Len(Trim(t(j))) Then NbMots = NbMots + 1
        Next j
    Next i
End Function

 

[Dudu2]

et je parle même pas des sub portions potentielle[.... ....[..... ..... .....].... .....] qui n'a pas été envisagé dans tout ce poste

Oui et d'autres séparateurs potentiels (virgules et autres).
Dans le ficher exemple on a [coup d'envoi]: 2 ou 3 mots ?

 

[patricktoulon]

non le replace ne fait que compliquer les chose la preuve tu step
regarde

Sub test()
chaine = "mot1 mot2[mot3 mot4 mot5] mot6 [mot7] mot8 [mot9 mot10] mot11 mot 12"
t = Split(chaine, "[")
texte = texte & "les chaines du first split sont" & vbCrLf & Join(t, vbCrLf) & vbCrLf & vbCrLf
texte = texte & "les chaines a garder sont :" & vbCrLf & vbCrLf
For i = 1 To UBound(t)
texte = texte & Split(t(i), "]")(0) & vbCrLf
Next
MsgBox texte
End Sub

 

[Dudu2]

Ok je vois ce que tu veux dire. Faudrait que j'adapte mon code pour ne pas avoir de Replace.

Mais le Replace, pour l'option de mapomme et la mienne, remplace un niveau de Split.
Alors bon, je ne sais pas ce qui est mieux. Toutes ces options fonctionnent avec leurs spécificités et leurs tolérances aux espaces.

 

[patricktoulon]

regarde j'ai ajouté la correction globale des espaces

Sub test()
chaine = "mot1 mot2[mot3            mot4      mot5]        mot6 [   mot7     ] mot8        [mot9     mot10] mot11 mot 12"
t = Split(Application.Trim(chaine), "[")
texte = texte & "les chaine du first split sont" & vbCrLf & Join(t, vbCrLf) & vbCrLf & vbCrLf
texte = texte & "les chaine a garder sont :" & vbCrLf & vbCrLf
For i = 1 To UBound(t)
texte = texte & Split(Application.Trim(t(i)), "]")(0) & vbCrLf
Next
MsgBox texte
End Sub

le principe est on ne peut plus simple
tu split le texte par le caractère de coupe de gauche et tu garde du 1 au ubound (le zero tu le zape d'office)
ensuite chaque portions trouvée tu les coupe par le caractère de coupe droite et cette fois ci tu garde que l' item zero de ces subsplit
et c'est tout
reste à envisager les virgule et autre caractères LA!!!! oui un replace sera nécessaire

 

[Dudu2]

OK, compris, ça marche.

 

[Aeser]

Super merci beaucoup, ça semble bien gérer les différents cas présents dans mon fichier.

Il n’y a pas de sub portions [.... ....[..... ..... .....].... .....], ni d’espace après ‘[‘ ou avant ‘]’ pour info.

Va vraiment falloir que je me mette au VBA