Remplacer caractères en indice et exposant

Bonjour au forum,

Je cherche à remplacer automatiquement certaines chaines de caractères avec des indices et/ou exposant, par exemple remplacer Fya par Fy"a en exposant", Fyb par Fy"b en exposant", ry par r"y en exposant", puis A1 par A"1 en indice", etc.

J'ai trouvé ce code proposé par Dhany en parcourant le forum mais impossible à l'adapter à mon cas, je n'arrive pas à intégrer un exposant dans VBA directement comme il l'a fait ci-après...

Auriez-vous une idée ?

Option Explicit

Sub Test()
  Dim c As Range, p As Byte
  For Each c In Application.Selection
    If c.Value <> "" Then
      c.Value = Replace$(c.Value, "m2", "m²")
      c.Value = Replace$(c.Value, "m3", "m³")
      p = InStr(UCase$(c.Value), "CO2")
      If p > 0 Then c.Characters(p + 2, 1).Font.Subscript = True
    End If
  Next c
End Sub

Un tout grand merci d'avance !

Bonjour Nrev74,

Voici un bout de piste, mais cela fonctionne en ne sélectionnant qu'une cellule à la fois :

Sub Test()
  Dim itext As String
  itext = Selection.Value
  If itext = "Fya" Or itext = "Fyb" Then
      Selection.Characters(Start:=Len(itext), Length:=1).Font.Superscript = True
  ElseIf itext = "A1" Then
      Selection.Characters(Start:=Len(itext), Length:=1).Font.Subscript = True
    End If
End Sub

Cordialement,

Bonjour, salut IronBoule !

J'ai voulu tenter quelque chose avec les caractères UNICODE correspondant aux indices et exposants... Mais ça n'a pas l'air de fonctionner comme prévu ! Soit je ne sais pas faire (probable !), soit le caractère n'est pas prit en charge par Excel et automatiquement transformé en nombre classique...

Le code testé :

Sub Test()

Dim Exposant(), Indice(), Chiffre As Integer

Exposant = Array(8304, 185, 178, 179, 8308, 8309, 8310, 8311, 8312, 8313)
Indice = Array(8320, 8321, 8322, 8323, 8324, 8325, 8326, 8327, 8328, 8329)
Chiffre = 6 'Remplacer le chiffre à tester
MsgBox "Chiffre : " & Chiffre & ", Indice : " & ChrW(Indice(Chiffre)) & ", Exposant : " & ChrW(Exposant(Chiffre))

End Sub

Bonjour Pedro22, IronBoule,

Merci beaucoup pour vos réponses !

J'ai pu bidouiller quelque chose en m'inspirant de vos propositions, ça m'a l'air de fonctionner pour l'instant

Sub MF()
    Dim c As Range
    For Each c In ActiveSheet.Range("B12:U30")
        If c.Value = "Fya" Or c.Value = "Fyb" Or c.Value = "ry" Then
            c.Characters(Start:=Len(c), Length:=1).Font.Superscript = True
        ElseIf c.Value = "A1" Or c.Value = "A2" Or c.Value = "R0" Or c.Value = "R1" Or c.Value = "R2" Or c.Value = "Rz" Or c.Value = "A2" Then
            c.Characters(Start:=Len(c), Length:=1).Font.Subscript = True
        End If
    Next c
End Sub

Donc après plusieurs tests, je me rends compte que je suis finalement bien loin du compte...

Mon problème est que les remplacements doivent aussi être effectués dans plusieurs plages de cellules, certaines fusionnées, et que les caractères à remplacer peuvent être également en plein milieu d'une chaîne...

Ci-joint un fichier exemple, ce sera plus explicite...

Merci pour votre aide !

petit up