Formater une saisie de texte

Le 16/11/20 Í  14:12, Apitos a écrit :

Bonjour Í  tous,

J'aimerais formater de façon automatique, une saisie de texte dans une cellule, de telle manière que lorsque je tape "1-2", le texte dans la cellule se changera en "F1-F2", avec 1 et 2 en indice.

Merci d'avance.

Bonjour,

Un clic droit sur l'onglet de la feuille o͹ l'action se déroule
Visualiser le code

Copie la procédure suivante dans la page blanche

Dans ma procédure, ce format particulier s'adresse Í  la plage de
cellules A1:A10. Adapte la plage pour celle qui convient Í  ton application.

'-----------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rg As Range, C As Range
Set Rg = Intersect(Range("A1:A10"), Target)

If Not Rg Is Nothing Then
For Each C In Rg
With C
.NumberFormat = "@"
If .Value = "1-2" Then
.Value = "F1-F2"
.Characters(2, 1).Font.Superscript = True
.Characters(5, 1).Font.Superscript = True
End If
End With
Next
End If
End Sub
'-----------------------------

MichD

Bonjour MichD,

J'ai exécuté le code et ça me donne un chiffre (43862).

Le 1-2 était un exemple. Il pourra être n'importe quel chiffre (1-2, 3-4, 5-6, 7-8, 9-10, ...23-24)

Le 16/11/20 Í  15:16, Apitos a écrit :

Bonjour MichD,

J'ai exécuté le code et ça me donne un chiffre (43862)

43862 représente une date au format numérique. Quand tu saisis par
exemple 1-2 Excel interprète cela comme étant le 1 février 2020 qui
transforme au format numérique.

Le 1-2 était un exemple. Il pourra être n'importe quel chiffre (1-2, 3-4, 5-6, 7-8, 9-10, ...23-24)

Essaie ceci :

'-------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rg As Range, C As Range
Set Rg = Intersect(Range("A1:A10"), Target)

If Not Rg Is Nothing Then
Application.EnableEvents = False
For Each C In Rg
With C
.NumberFormat = "@"
x = .Value
If .Value Like "[0-9]-[0-9]" Then
.Value = "F" & Left(x, 1) & "-F" & Right(x, 1)
.Characters(2, 1).Font.Superscript = True
.Characters(5, 1).Font.Superscript = True
End If
End With
Next
Application.EnableEvents = True
End If
End Sub
'-------------------------------

MichD

J'ai essayé d'adapter le code, comme ceci :

'-------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rg As Range, C As Range
Set Rg = Intersect(Range("A1:A10"), Target)

If Not Rg Is Nothing Then
Application.EnableEvents = False
For Each C In Rg
With C
.NumberFormat = "@"
x = .Value
y = Split(x, "-")
If IsNumeric(y) Then ' Si le tableau résultant est numérique
.Value = "F" & y(0) & "-F" & y(1)
.Characters(2, 1).Font.Subscript = True
.Characters(5, 1).Font.Subscript = True
End If
End With
Next
Application.EnableEvents = True
End If
End Sub

Parce que le test

If .Value Like "[0-9]-[0-9]" Then

ne prend pas en charge les chiffres Í  deux nombres.

mais, ma modification, n'a pas marché sur le test :

If IsNumeric(y) Then ' Si le tableau résultant est numérique

Le 16/11/20 Í  16:46, Apitos a écrit :

J'ai essayé d'adapter le code, comme ceci :

'-------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rg As Range, C As Range
Set Rg = Intersect(Range("A1:A10"), Target)

If Not Rg Is Nothing Then
Application.EnableEvents = False
For Each C In Rg
With C
.NumberFormat = "@"
x = .Value
y = Split(x, "-")
If IsNumeric(y) Then ' Si le tableau résultant est numérique
.Value = "F" & y(0) & "-F" & y(1)
.Characters(2, 1).Font.Subscript = True
.Characters(5, 1).Font.Subscript = True
End If
End With
Next
Application.EnableEvents = True
End If
End Sub

Parce que le test

If .Value Like "[0-9]-[0-9]" Then

ne prend pas en charge les chiffres Í  deux nombres.

mais, ma modification, n'a pas marché sur le test :

If IsNumeric(y) Then ' Si le tableau résultant est numérique

Je réponds Í  ce que tu demandes, pas Í  ce que tu as en tête.

essaie ceci :
'--------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rg As Range, C As Range, X As Variant
Set Rg = Intersect(Range("A1:A10"), Target)

If Not Rg Is Nothing Then
Application.EnableEvents = False
For Each C In Rg
With C
.NumberFormat = "@"
X = Split(.Value, "-")
If .Value Like "[0-9]-[0-9]" Or _
.Value Like "[0-9]-[0-9][0-9]" Then
.Value = "F" & 2 & "-F" & Right(X(1), Len(X(1)))
.Characters(2, Len(X(0))).Font.Superscript = True
.Characters(5, Len(X(1))).Font.Superscript = True
End If
If .Value Like "[0-9][0-9]-[0-9]" Or _
.Value Like "[0-9][0-9]-[0-9][0-9]" Then
.Value = "F" & Left(X(0), Len(X(0))) & "-F" &
Right(X(1), Len(X(1)))
.Characters(2, Len(X(0))).Font.Superscript = True
.Characters(6, Len(X(1))).Font.Superscript = True
End If
End With
Next
Application.EnableEvents = True
End If
End Sub
'--------------------------------------

MichD

Le 16/11/20 Í  17:54, MichD a écrit :

Le 16/11/20 Í  16:46, Apitos a écrit :

J'ai essayé d'adapter le code, comme ceci :

'-------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
     Dim Rg As Range, C As Range
     Set Rg = Intersect(Range("A1:A10"), Target)

     If Not Rg Is Nothing Then
         Application.EnableEvents = False
         For Each C In Rg
             With C
                 .NumberFormat = "@"
                 x = .Value
                 y = Split(x, "-")
                 If IsNumeric(y) Then ' Si le tableau résultant est
numérique
                     .Value = "F" & y(0) & "-F" & y(1)
                     .Characters(2, 1).Font.Subscript = True
                     .Characters(5, 1).Font.Subscript = True
                 End If
             End With
         Next
         Application.EnableEvents = True
     End If
End Sub

Parce que le test

If .Value Like "[0-9]-[0-9]" Then

ne prend pas en charge les chiffres Í  deux nombres.

mais, ma modification, n'a pas marché sur le test :

  If IsNumeric(y) Then ' Si le tableau résultant est numérique

Je réponds Í  ce que tu demandes, pas Í  ce que tu as en tête.

essaie ceci :
'--------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rg As Range, C As Range, X As Variant
Set Rg = Intersect(Range("A1:A10"), Target)

If Not Rg Is Nothing Then
    Application.EnableEvents = False
    For Each C In Rg
        With C
            .NumberFormat = "@"
            X = Split(.Value, "-")
            If .Value Like "[0-9]-[0-9]" Or _
                .Value Like "[0-9]-[0-9][0-9]" Then
                    .Value = "F" & 2 & "-F" & Right(X(1), Len(X(1)))
                    .Characters(2, Len(X(0))).Font.Superscript = True
                    .Characters(5, Len(X(1))).Font.Superscript = True
            End If
            If .Value Like "[0-9][0-9]-[0-9]" Or _
                 .Value Like "[0-9][0-9]-[0-9][0-9]" Then
                 .Value = "F" & Left(X(0), Len(X(0))) & "-F" &
Right(X(1), Len(X(1)))
                .Characters(2, Len(X(0))).Font.Superscript = True
                .Characters(6, Len(X(1))).Font.Superscript = True
           End If
        End With
    Next
    Application.EnableEvents = True
End If
End Sub
'--------------------------------------

MichD

Ce serait mieux comme ceci :

'---------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rg As Range, C As Range, X As Variant
Set Rg = Intersect(Range("A1:A10"), Target)

If Not Rg Is Nothing Then
Application.EnableEvents = False
For Each C In Rg
With C
.NumberFormat = "@"
X = Split(.Value, "-")
If .Value Like "[0-9]-[0-9]" Or _
.Value Like "[0-9]-[0-9][0-9]" Then
.Value = "F" & 2 & "-F" & Right(X(1), Len(X(1)))
.Characters(2, Len(X(0))).Font.Superscript = True
.Characters(5, Len(X(1))).Font.Superscript = True
Else
If .Value Like "[0-9][0-9]-[0-9]" Or _
.Value Like "[0-9][0-9]-[0-9][0-9]" Then
.Value = "F" & Left(X(0), Len(X(0))) & "-F" &
Right(X(1), Len(X(1)))
.Characters(2, Len(X(0))).Font.Superscript = True
.Characters(6, Len(X(1))).Font.Superscript = True
End If
End If
End With
Next
Application.EnableEvents = True
End If
End Sub
'---------------------------------------------

MichD

Bonjour MichD,

Quand un chiffre Í  gauche en nombre unique (1-x Í  9-x), sera formater en 'F2' :

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

Petite correction apportée :

'---------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rg As Range, C As Range, X As Variant
Set Rg = Intersect(Range("A1:A10"), Target)

If Not Rg Is Nothing Then
Application.EnableEvents = False
For Each C In Rg
With C
.NumberFormat = "@"
X = Split(.Value, "-")
If .Value Like "[0-9]-[0-9]" Or _
.Value Like "[0-9]-[0-9][0-9]" Then
.Value = "F" & X(0) & "-F" & Right(X(1), Len(X(1)))
.Characters(2, Len(X(0))).Font.Superscript = True
.Characters(5, Len(X(1))).Font.Superscript = True
Else
If .Value Like "[0-9][0-9]-[0-9]" Or _
.Value Like "[0-9][0-9]-[0-9][0-9]" Then
.Value = "F" & Left(X(0), Len(X(0))) & "-F" &
Right(X(1), Len(X(1)))
.Characters(2, Len(X(0))).Font.Superscript = True
.Characters(6, Len(X(1))).Font.Superscript = True
End If
End If
End With
Next
Application.EnableEvents = True
End If
End Sub
'---------------------------------------

MichD

Merci MichD.

Mais pourquoi la macro semble désactivée, comme illustrée dans l'image suivante :

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

Le 18/11/20 Í  14:26, Apitos a écrit :

Merci MichD.

Mais pourquoi la macro semble désactivée, comme illustrée dans l'image suivante :

Quand tu tapes dans une cellule 1-2, Excel reconnaÍ®t cette donnée comme
étant une date soit le 1 février 2020. L'exécution de la macro va
modifier cette entrée en format numérique 43862.

Cette reconnaissance est l'une caractéristique d'Excel et il n'existe
pas d'options pour la supprimer.

Par conséquent, le format de départ des cellules de la plage doit être
au format standard ou au format texte.

Supprime la colonne et tape la donnée dans la nouvelle colonne, cela
devrait fonctionner.

MichD