XL 2019 Comment extraire données soulignés excel?

kevin.lvd · 25 Janvier 2021

Bonjour,

j'ai vu dans un ancien forum qu'il était possible d'extraire les données souligné d'une cellule avec cette macro

Sub Macro1()
Dim dl As Integer 'déclare la variable dl (Dernière Ligne)
Dim c As String 'déclare la variable c (Caractère)
Dim m As String 'déclare la variable m (Mot)
Dim i As Integer 'déclare la variable i (Incrément)

With Sheets("Feuil1") 'prend en compte l'onglet "Feuil1"
dl = .Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée dl de la colonne A
For Each cel In .Range("A2:A" & dl) 'boucle 1 : sur toutes les cellule éditées cel de la colonne A
m = "" 'réinitialise la variable m
For i = 1 To Len(cel.Value) 'boucle 2 : sur tos les caractères de la cellule cel
'si le caractère est souligné rajoute le caractère au mot m
If cel.Characters(Start:=i, Length:=1).Font.Underline = xlUnderlineStyleSingle Then m = m & Mid(cel.Value, i, 1)
Next i 'prochain caractère de la boucle 2
cel.Offset(0, 1).Value = m 'place le mot m dans la colonne B
Next cel 'prochaine cellule de la boucle 1
End With 'fin de la prise en compte de l'onglet "Feuil1"
End Sub

Mon problème c'est que dans une cellule, il y a plusieurs mots soulignés. Du coup lorsque que j'exécute la macro, je me retrouve bien avec les mots soulignés, mais ils ne sont pas séparés...

Est ce que vous auriez une idée de comment mettre cela en oeuvre ?

Merci par avance !

kevin.lvd · 25 Janvier 2021

@Phil69970 et @Staple1600 Merci beaucoup pour le temps que vous avez consacré à ce problème.

J'ai l'honneur de vous annoncer que cela fonctionne. J'ai utilisé la première macro Test_Souligné. Cela ma donc sortie toutes les personnes soulignées avec plusieurs "|".

J'ai ensuite utilisé la deuxième macro Test_2, qui a permis de dispatcher les différentes personnes dans plusieurs colonnes. Ensuite j'ai sélectionné toutes les cellules vides et je les ai supprimer. Ce qui me donne exactement ce que je voulais. Merci encore !!!!

Staple1600 · 25 Janvier 2021

Re

En attendant une version allinone par tableau

VB:

Sub traitement()
Application.ScreenUpdating = False
extraction
nettoyage
finition
End Sub
Private Sub extraction()
Dim i&, c&
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
    For c = 1 To Len(Cells(i, 1))
        With Cells(i, 1).Characters(c, 1)
            If .Text = "," Then mot = mot & "|"
                If .Font.Underline = xlUnderlineStyleSingle Then
                mot = mot & Mid(Cells(i, 1).Value, c, 1)
            End If
            End With
        Next c
    Cells(i, 2).Value = mot
    mot = ""
Next i
End Sub
Private Sub nettoyage()
Dim vArr
vArr = Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1))
Columns(2).TextToColumns _
                        Destination:=Range("C1"), DataType:=xlDelimited, _
                        Other:=True, OtherChar:="|", _
                        FieldInfo:=vArr
End Sub
Private Sub finition()
Dim i&, lr&
lr = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To lr
Range("C" & i, "Z" & i).Sort _
        Key1:=Range("C" & i), Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, _
        MatchCase:=False, Orientation:=xlLeftToRight, DataOption1:=xlSortNormal
Next i
End Sub

XL 2019 Comment extraire données soulignés excel?

kevin.lvd

XLDnaute Nouveau

kevin.lvd

Staple1600

XLDnaute Barbatruc

Discussions similaires