Formater une chaine

On pourra aussi, par la suite, garder Í  l'esprit que la sous-chaÍ®ne sera saisie directement dans la cellule, et non simplement extraite comme c'est le cas au départ.

Merci.

Le 19/02/22 Í  18:54, Apitos a écrit :

On pourra aussi, par la suite, garder Í  l'esprit que la sous-chaÍ®ne sera saisie directement dans la cellule, et non simplement extraite comme c'est le cas au départ.

Merci.

Bonjour,

Un exemple de macro si tu veux transformer le contenu de la cellule A1 :
E1 (7-8) comme tu le désires avec des indices. On s'entend, ceci n'est
pas application au résultat d'une formule, mais d'une chaÍ®ne de
caractère dans une cellule.

Si ton contenu peut-être autre comme E1 (77-81), cela ne fonctionne pas.
Il faut ajouter du code...

'-------------------------------
Sub test()
Dim X As Long
With Range("A1")
X = Application.WorksheetFunction.Find("-", .Value)
.Value = Replace(.Value, .Characters(X - 1).Text, "F" &
.Characters(X - 1).Text)
.Value = Replace(.Value, .Characters(X + 2).Text, "F" &
.Characters(X + 2).Text)
.Characters(2, 1).Font.Subscript = True
.Characters(X - 1, 1).Font.Subscript = True
.Characters(X + 3, 1).Font.Subscript = True
End With
End Sub
'-------------------------------

Si tu dois saisir ce type de chaͮne dans la cellule, tu peux utiliser ceci:

'------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
ss = Target.Cells.Count
If Target.Characters.Count = 8 Then
Application.EnableEvents = False
With Target
X = Application.WorksheetFunction.Find("-", .Value)
.Value = Replace(.Value, .Characters(X - 1).Text, "F" &
.Characters(X - 1).Text)
.Value = Replace(.Value, .Characters(X + 2).Text, "F" &
.Characters(X + 2).Text)
.Characters(2, 1).Font.Subscript = True
.Characters(X - 1, 1).Font.Subscript = True
.Characters(X + 3, 1).Font.Subscript = True
End With
Application.EnableEvents = True
End If

End Sub
'------------------------------------


MichD

Bonjour MichD,

Merci pour le code.

Dans l'exemple joint, en colonne G, j'ai des données qui ont déjÍ  été saisies auparavant, mais je souhaite les organiser d'une autre manière, en extrayant une sous-chaÍ®ne, par formule pour les données déjÍ  présentes, dans la colonne C, mais en les saisissant directement dans la cellule, pour les données qui viendront plus tard.

Après, je devrais appliquer un format spécial sur la colonne C de la forme : Xn (Fn-Fn)

https://www.cjoint.com/c/LBuuIcKsrbY

Tu devrais retenir cette approche.
N'oublie pas d'adapter le nom de la feuille si nécessaire

'----------------------------------------
Sub test1()
Dim Rg As Range, C As Range, S As String
Dim Long1 As Long, Long2 As Long, T As Variant
Dim Sect1 As String, Sect2 As String, Sect3 As String

With Worksheets("Feuil1") 'Nom de l'onglet feuille Í  adapter
'La plage de cellule Í  traiter
Set Rg = .Range("H2:H" & .Range("H" & .Rows.Count).End(xlUp).Row)
End With
Application.EnableEvents = False
Application.ScreenUpdating = False

For Each C In Rg
If C <> "" Then
If InStr(1, C.Value, "REG", vbTextCompare) <> 0 Then

With C
T = Trim(Split(.Value, "REG")(1))
End With
'Section 1 représentée par le chiffre et la
'lettre avant la parenthèse
Sect1 = Trim(Split(T, "(")(0))
Long1 = Len(Sect1)

'Section 2 représentée par les premiers chiffres
'après l'ouverture de la parenthèse
S = Split(T, "(")(1)
Sect2 = Split(S, "-")(0)
Long2 = Len(Sect2)

'Section 3 représentée par les derniers chiffres
'après la fermeture de la parenthèse
Sect3 = Replace(S, Sect2 & "-", "")
Sect3 = Left(Sect3, Len(Sect3) - 1)

With C.Offset(, -5)
'Reconstruction du contenu que doit prendre la cellule
.Value = Sect1 & " (F" & Sect2 & "-F" & Sect3 & ")"
'Appliquer le format Í  chacune des section
.Characters(2, Len(Sect1) - 1).Font.Subscript = True
.Characters(Long1 + 4, Len(Sect2)).Font.Subscript = True
.Characters(Long1 + 4 + Long2 + 2, Len(Sect2) +
1).Font.Subscript = True
End With
End If
End If
Next
End Sub
'----------------------------------------

MichD

Le 21/02/22 Í  06:47, MichD a écrit :

Tu devrais retenir cette approche.
N'oublie pas d'adapter le nom de la feuille si nécessaire

'----------------------------------------
Sub test1()
Dim Rg As Range, C As Range, S As String
Dim Long1 As Long, Long2 As Long, T As Variant
Dim Sect1 As String, Sect2 As String, Sect3 As String

With Worksheets("Feuil1") 'Nom de l'onglet feuille Í  adapter
    'La plage de cellule ͠ traiter
    Set Rg = .Range("H2:H" & .Range("H" & .Rows.Count).End(xlUp).Row)
End With
Application.EnableEvents = False
Application.ScreenUpdating = False

For Each C In Rg
    If C <> "" Then
    If InStr(1, C.Value, "REG", vbTextCompare) <> 0 Then

    With C
        T = Trim(Split(.Value, "REG")(1))
    End With
       'Section 1 représentée par le chiffre et la
       'lettre avant la parenthèse
        Sect1 = Trim(Split(T, "(")(0))
        Long1 = Len(Sect1)

        'Section 2 représentée par les premiers chiffres
        'après l'ouverture de la parenthèse
        S = Split(T, "(")(1)
        Sect2 = Split(S, "-")(0)
        Long2 = Len(Sect2)

        'Section 3 représentée par les derniers chiffres
        'après la fermeture de la parenthèse
        Sect3 = Replace(S, Sect2 & "-", "")
        Sect3 = Left(Sect3, Len(Sect3) - 1)

     With C.Offset(, -5)
        'Reconstruction du contenu que doit prendre la cellule
        .Value = Sect1 & " (F" & Sect2 & "-F" & Sect3 & ")"
        'Appliquer le format ͠ chacune des section
        .Characters(2, Len(Sect1) - 1).Font.Subscript = True
        .Characters(Long1 + 4, Len(Sect2)).Font.Subscript = True
        .Characters(Long1 + 4 + Long2 + 2, Len(Sect2) +
1).Font.Subscript = True
    End With
    End If
    End If
Next
End Sub
'----------------------------------------

MichD

Il y a une erreur dans la dernière ligne de code. Remplace :
.Characters(Long1 + 4 + Long2 + 2, Len(Sect2) +
1).Font.Subscript = True

Par
.Characters(Long1 + 4 + Long2 + 2, Len(Sect3)).Font.Subscript = True

MichD

Bonjour MichD,

Merci pour le code corrigé.

Après plusieurs tests, le voici :

***** Code d'extraction de données :
'----------------------------------------
Sub ExtractionDonnees()
Dim Rg As Range, C As Range, S As String
Dim Long1 As Long, Long2 As Long, T As Variant
Dim Sect1 As String, Sect2 As String, Sect3 As String

With Worksheets("Feuil1") 'Nom de l'onglet feuille Í  adapter
'La plage de cellule Í  traiter
Set Rg = .Range("H2:H" & .Range("H" & .Rows.Count).End(xlUp).Row)
End With
Application.EnableEvents = False
Application.ScreenUpdating = False

For Each C In Rg
If C <> "" Then
If InStr(1, C.Value, "REG", vbTextCompare) <> 0 Then

With C
T = Trim(Split(.Value, "REG")(1))
End With
'Section 1 représentée par le chiffre et la
'lettre avant la parenthèse
Sect1 = Trim(Split(T, "(")(0))
Long1 = Len(Sect1)

'Section 2 représentée par les premiers chiffres
'après l'ouverture de la parenthèse
S = Split(T, "(")(1)
Sect2 = Split(S, "-")(0)
Long2 = Len(Sect2)

'Section 3 représentée par les derniers chiffres
'après la fermeture de la parenthèse
Sect3 = Replace(S, Sect2 & "-", "")
Sect3 = Left(Sect3, Len(Sect3) - 1)

With C.Offset(, -5)
'Reconstruction du contenu que doit prendre la cellule
.Value = Sect1 & " (F" & Sect2 & "-F" & Sect3 & ")"
With .Characters(2, Len(Sect1) - 1).Font
.FontStyle = "Gras"
.Subscript = True
.ColorIndex = 3
End With

With .Characters(Long1 + 4, Len(Sect2)).Font
.FontStyle = "Gras"
.Subscript = True
.ColorIndex = 3
End With

With .Characters(Long1 + 4 + Long2 + 2, Len(Sect3)).Font
.FontStyle = "Gras"
.Subscript = True
.ColorIndex = 3
End With
End With
End If
End If
Next
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
'----------------------------------------


***** Code de saisie direct dans la cellule :
'---------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)

ss = Target.Cells.Count
If Target.Characters.Count > 5 And Target.Characters.Count < 10 Then
Application.EnableEvents = False

'Mettre le premier caractere en majuscule
Target = StrConv(Target, vbProperCase)
Target.Font.Size = 12
With Target
a = Split(.Value, " ")
b = Split(a(1), "-")

LongG = Len(b(0))
LongD = Len(b(1))

X = Application.WorksheetFunction.Find("-", .Value)

.Value = Replace(.Value, .Characters(X - LongG).Text, "(F" & .Characters(X - LongG).Text)
.Value = StrReverse(Replace(StrReverse(.Value), StrReverse(.Characters(X + 3).Text), StrReverse("F" & .Characters(X + 3).Text & ")"), , 1))

With .Characters(2, Len(a(0)) - 1).Font
.FontStyle = "Gras"
.Subscript = True
.ColorIndex = 3
End With

X = Application.WorksheetFunction.Find("-", .Value)
Debug.Print "X = " & X
With .Characters(X - LongG, LongG).Font
.FontStyle = "Gras"
.Subscript = True
.ColorIndex = 3
End With

With .Characters(X + 2, LongD).Font
.FontStyle = "Gras"
.Subscript = True
.ColorIndex = 3
End With
End With
Application.EnableEvents = True
End If

End Sub
'---------------------------------------

Le 21/02/22 Í  18:25, Apitos a écrit :

.ColorIndex = 3

La couleur retournée par colorindex n'est pas nécessairement la même
d'un ordinateur Í  l'autre. Si tu veux appliquer la couleur "Rouge", ce
serait préférable que tu utilises.

.Color = VBred

au lieu de ceci :
.FontStyle = "Gras"

.Bold = True n'était pas suffisant si tu voulais le texte en gras?


N.B. Dans ta question initiale, il n'était pas question de définir ces
caractéristiques du texte mis en indice.
.FontStyle = "Gras"
.Subscript = True
.ColorIndex = 3

Difficile d'avoir ce que l'on a pas demandé... ;-)

MichD

Bonjour MichD,

J'ai ajouté quelques fonctionnalités pour des raisons d'esthétique d'affichage.

J'ai mis le dernier code utilisé afin de le corriger, puis pour que quelqu'un d'autre puisse en profiter.

Après l'extraction des données depuis la colonne H, la forme de la saisie traitée sera comme suit :

an x-y

qui sera transformé en

An (Fx-Fy).

Je vais apporter les corrections proposées, en attendant que le code soit amélioré si tu le juges nécessaire.

Exemple mise Í  jour : https://www.cjoint.com/c/LBwnjhm45aP

Merci.

Le 19/02/22 Í  18:00, Apitos a écrit :

Bonjour,

J'ai réussi Í  extraire la sous-chaine :
E1 (7-8)

de cette chaine :
ODF3 REG E1 (7-8)

avec la formule :
=STXT(H7;TROUVE("REG";H7)+4;TROUVE(")";H7)-TROUVE("REG";H7)+4)

Alors, j'aimerais formater ce que je viens d'extraire dans cette format :
https://www.cjoint.com/c/LBtxaz8lemY

Merci.

Pour le plaisir, j'ai apporté quelques légères modifications.

https://www.cjoint.com/c/LBwpRZaLACF

MichD

P.S. Il m'arrive que le service de messagerie refuse l'envoi des
messages. Je dois répondre sur un nouveau fil.