XL 2010 extraire des mots en gras

[carber]

Bonjour j'ai un fichier qui me permet extraire des mots en gras le souci que je n'arrive pas a mettre chaque mot dans une cellule

par exemple dans une phrase j'ai deux mot en gras ou plus alors quand j’exécute le bouton il me colle les mot qui sont en gras je souhaite les mettre chaque mot dans une cellule

svp
cordialement

 

[patricktoulon]

re
Bonjour @sylvanu
une petite correction tout de meme (il fallait bien que j'en fasse une hein !!)

comme parfois l'espace devant ou après est en bold aussi il arrive parfois que l'on est en colonne 1 ou dernière du résultat un espace
donc
la ligne corrigée
mots = Split(Trim(chainebolds(a).innertext))

je n'ai pas dimé toute les variables aussi je vous laisse deviner de quel type elle doivent etre pour les déclarer
et voilà

 

[sylvanu]

Re,
Alors, just for the fun.
Si toute la cellule est en gras, alors il n'y a aucune remontée.( ligne 2 )
Si toute la cellule est en gras, sauf un mot alors la remontée est correcte. (ligne 3 ou 4 )

"Just for the fun" car c'est une situation qu'il m'étonnerait que Carber rencontre.

 

[job75]

@job75 perso je pige pas moins de 3 secondes tu dis ?

Oui et pour tes 22 secondes soit ton ordi se traîne soit tu t'es trompé de macro.

 

[job75]

Chez moi sur Excel 2019 64 bits pour le fichier du post #14 :

- bouton de gauche 3,03 secondes

- bouton de droite 3,13 secondes, c'est donc la même chose.

 

[patricktoulon]

re
@job75 je peux pas me tromper de macro il n'y a que ton code a l’intérieur j'ai testé ton fichier post#12 tel quel

il se traîne pas puisque qu'avec ma version xmlhtml je met moins d'une demie secondes pour 800 lignes
je ne te raconte pas d'histoire regarde

 

[job75]

Donc nos ordis se comportent très différemment, c'est quand même curieux.

 

[patricktoulon]

ben oui c'est bizarre
2013 32 bits W7 64

 

[mapomme]

Bonjour à tous ,

Bon puisque chacun y va de sa petite version et qu'ici il fait gris et qu'il pleut, ma pomme se fend aussi de sa p'tite version. Avec une variante:

• Les mots consécutifs en gras sont considérés comme une seule expression
• on considère (ce qui semble être le cas) que si la 1ère lettre d'un mot est en gras alors le mot est en gras

C'est assez rapide. Sur ma bécane, pour 800 lignes => autour de 3 s.

 

[patricktoulon]

Bonjour @mapomme
et ben dis donc je t'aurais attendu toi t'en a mis du temps
je vois que ca t'a interpeller toi aussi

je suis entrain de travailler sur une variante de celle de @job75 histoire de jumper un peu plus vite
je regarde la tienne ensuite

 

[patricktoulon]

re
22.68 secondes pour le model de @mapomme
et "bonne humeur" sont deux mots

 

[mapomme]

Bonjour @patricktoulon

et ben dis donc je t'aurais attendu toi t'en a mis du temps

Je suis beaucoup moins présent sur XLD depuis quelques temps. J'ai vu par hasard que ça "frétillait" sur ce fil, j'ai donc un peu codé pour ne pas trop perdre la main.

22.68 secondes pour le model de @mapomme

Tu utilises un Amstrad ou un Commodore ? De quelle année ?
Résultats très étranges.

et "bonne humeur" sont deux mots

J'ai bien précisé que c'est une variante. Dans l'exemple du demandeur, les mots en gras semblent être des états ou des sentiments.
"Bonne" n'en est pas un, "humeur" non plus mais "bonne humeur" l'est... Et je le suis

 

[patricktoulon]

ben non j'utilise un pc normal
j'ai essayé ca aussi mais je met encore plus de 22 secondes

Sub Entrer_Mots_Gras()
    Dim T, cel As Range, tb
    T = Timer
    Application.ScreenUpdating = False
    [B1].Resize(Rows.Count, 6).ClearContents
    With ActiveSheet.UsedRange
        For Each cel In .Cells
            tb = Mots_Gras(cel)
            cel.Offset(, 1).Resize(, UBound(tb)) = tb
        Next
    End With
    MsgBox "Durée " & Format(Timer - T, "0.00 \sec")
End Sub
Sub testInstrdoloop()
     Mots_Gras$ ([A3])
End Sub
Function Mots_Gras(c As Range)
    Dim x$, s, I%, n%, pos&, z&, s2
    x = c.Value & " "
    s = Split(x)
     ReDim s2(1 To UBound(s))
    If UBound(s) = 0 Then Exit Function
    pos = 1
    For I = 0 To UBound(s)
        z = InStr(pos, c.Value, s(I))
         If c.Characters(z, 1).Font.Bold = True Then n = n + 1: s2(n) = s(I):
        pos = pos + Len(s(I))
    Next
     Mots_Gras = s2
End Function

 

[job75]

Bonjour mapomme,

Sur mon ordi la macro de ton fichier s'exécute en 3,1 secondes, nos ordis sont semblables.

A+

 

[mapomme]

Bonjour @job75 ,

Merci d'avoir testé. Les résultats de @patricktoulon sont étranges.

Concernant le fichier du post #14:

• bouton de gauche : 3 s
• bouton de droite : 1,8 s

 

[patricktoulon]

pour vous donner une idée de mon etonnement je viens de tester un tableau global en restitution globale
c'est a dire que la fonction renvoie le tableau de toutes les ligne d'un coup
et surprise c'est kif kif a 1 seconde près j'ai le même temps 23,xx secondes
autrement sur mon install je travaille casiment a la meme vitesse avec un range qu'avec une variable tableau

j'avoue je suis décontenancé et agacé

si vous voulez bien tester

Option Explicit

Sub Entrer_Mots_Gras()
    Dim T, tb, Rng As Range
    T = Timer
    [B1].Resize(Rows.Count, 150).ClearContents
    Set Rng = ActiveSheet.UsedRange
    tb = Mots_Gras(Rng)
    Rng.Offset(, 1).Resize(, UBound(tb)) = tb


    MsgBox "Durée " & Format(Timer - T, "0.00 \sec")
End Sub


Function Mots_Gras(Rng As Range)
    Dim x, I%, n%, pos&, z&, a&, tbl2
    ReDim tbl2(1 To Rng.Rows.Count, 20)
    For I = 1 To UBound(tbl2)
        x = Split(Rng.Cells(I, 1).Value)
        pos = 1
        n = 0
        For a = 0 To UBound(x)
            z = InStr(pos, Rng.Cells(I, 1), x(a))
            If Rng.Cells(I, 1).Characters(z, 1).Font.Bold = True Then n = n + 1: tbl2(I, n) = x(a)
            pos = pos + Len(x(a))
        Next
    Next
    Mots_Gras = tbl2
End Function

je vais faire un dernier test (je soupconne un truc ) et déjà remarqué et je reviens