Texte SUBSTITUEX

[patricktoulon]

Bonsoir a tous
ras le bol des formules avec substitue a répétition de 36 kilomètres
voici SUBSTITUEX
Comme sa petite sœur native d'Excel elle substitue

somme toute ça casse pas une brique me direz vous

sauf qu'elle est capable de substituer un array de caractère ou array d'expressions par un caractère ou array de caractères ou expression ou array d'expressions ou un mélange
le tout en 4/5 lignes de code

1. l'argument 1 la cellule ou un string
2. l'argument 2 un array de caractères ou d'expressions
3. l'argument 3 un array de carateres ou d'expression(numerique ou string) ou un string ou rien

les array dans les formules se codent entre accolades comme ceci

pour un array de valeurs string {"toto";"titi";"loulou"}
pour un array de valeurs numériques {4;8;2}

Function SUBSTITUEX(T As String, arr, Optional ByVal arr2 = "")
  Dim I&, Q
  For I = 1 To UBound(arr)
        If IsArray(arr2) Then
            If UBound(arr2) <> UBound(arr) Then SUBSTITUEX = "notEqualBoundary": Exit Function
            Q = arr2(I, 1)
        Else: Q = arr2
        End If
        T = Replace(T, arr(I, 1), Q)
    Next
    SUBSTITUEX = T
End Function

imaginons
en A2 j'ai abcdefghijklmnopqrstuvwxyz

formule 1 :=SUBSTITUEX(A2;{"a";"d";"g"};"")
cette formule va replacer les lettre de l'array par rien
--------------------------------------------------------------
formule 2:=SUBSTITUEX(A2;{"a";"d";"g"};{"|";"@";"$"})
cette formule va replacer chaque item de l'array 1 (argument 2) par chaque item du même index de l'array 2 (argument 3)

formule3: =SUBSTITUEX(A2;{"ab";"ij";"op"};{"|";"@";"$"})
cette formule replace chaque expressions de l'array 1(argument 2) par un caractère( item du même index) de l'array 2(argument 3)

formule 4:=SUBSTITUEX(A2;{"a";"i";"p"};"toto")
cette formule remplace chaque caractère de l'array 1 (argument 2) par la même expression (argument 3)

si vous décidez d’argumenter 2 array et que l'array( 2) argument 3) n'a pas le même nombre d'item
vous aurez dans la cellule notEqualBoundary

ps: a noter qu'elle fonctionne aussi pour les numérique dans toute ces variantes
=SUBSTITUEX(A9;{"2";"6";"8"};{3;7;9})

à noter aussi que l'array 2 (argument 3) peut être un array de numériques , caractères , expressions mélangées

voila c'est pas de la grande fonction mais pour coder un multiple substitue dans une cellule ça devient tout de suite plus simple

 

[patricktoulon]

Bonjour à tous
SUBSTITUEX prend du muscle

on peut désormais envoyer des ranges pour les arguments

pour cela j'y ai adjoint ma fonction perso GetdimensionTypeArray

qui me permet de pouvoir déterminer le redimensionnement en array (1 DIM) ou pas !! selon le cas


voici la fonction GetdimensionTypeArray
elle renvoie

1. "tableau" pour un range de x lignes et Y colonnes (donc 2 dim)
2. "ligne" pour un range de 1 ligne sur X colonnes(donc 2 dim)
3. "vertical" pour un range de x lignes sur 1 colonne (donc 2 dim)
4. "array" si c'est un simple array (donc 1 dim)

Function GetdimensionTypeArray(T)
'Fonction pour determiner le type de dimensionnement de la variable injectée(T)
'patricktoulon
    Dim Tx, x&, Z, x2, z2&
    z2 = UBound(T): If z2 = 0 Then x2 = Z + 1: x = x2 Else x = Z: x2 = x
    Z = Switch(z2 = 1, "ligne", TypeName(Application.Index(T, z2, 2)) <> "Error", "Tableau", x = x2, "vertical", x < x2 Or x > 1, "array")
    If Z = "vertical" And TypeName(Application.Index(T, z2, 1)) = "Error" Then Z = "array"
    GetdimensionTypeArray = Z
End Function

1. on peut donc maintenant envoyer dans la fonction SUBSTITUEX
2. un range (x lignes / 1 colonne)'pour les deux arrays
3. un range (1 lignes/Y colonnes)'pour les deux arrays
4. et toujours l'array formule codé entre accolades {"x";"y";"z"}
5. ou même un simple array si utilisation VBA

'***************************************************************
' fonction de SUBSTITUEX (homolgue la fonction native "SUBSTITUE"
' auteur :patricktoulon
' date 08/06/2021
' version 1.0
' commentaires:
' Cette fonction sert a substituer  un/des (caractères/ partie de chain) par un/des (caractères /partie de chaine) ou un mélange
' elle a pour vocation de diminuer le script des formules imbuvable quand trop de substitue
' quand elle est plusieurs fois utilisée dans une formule
'
' mise ajour
' version 1.2
' date 19/02/2022
' renommage des arguments(plus explicites)
' les arguments peuvent maintenant etre  aussi des Ranges (1 ligne/x colonnes) ou (x lignes / 1 colonne)
' adjonction de la fonction (( GetdimensionTypeArray  ))
' cette fonction  me permet de déterminer (si /et) comment je ramène les arguments a un simple array 1 dim
' ajout de la macro description
'*************************************************************
Option Explicit
Function SUBSTITUEX(T As String, ByVal elements_a_remplacer As Variant, Optional ByVal elements_de_remplacement As Variant = "")
    Dim I&, Q$
   
    'conversion en variable tableau si Typerange
    elements_a_remplacer = elements_a_remplacer
    elements_de_remplacement = elements_de_remplacement

    'conversion en array 1 dimension selon le type d'array injecté
    Select Case GetdimensionTypeArray(elements_a_remplacer)
    Case "vertical": elements_a_remplacer = Application.Transpose(elements_a_remplacer):
    Case "ligne": elements_a_remplacer = Application.Index(elements_a_remplacer, 1, 0)
    End Select

    Select Case GetdimensionTypeArray(elements_de_remplacement)
    Case "vertical": elements_de_remplacement = Application.Transpose(elements_de_remplacement)
    Case "ligne": elements_de_remplacement = Application.Index(elements_de_remplacement, 1, 0)
    End Select

    For I = LBound(elements_a_remplacer) To UBound(elements_a_remplacer)
        If IsArray(elements_de_remplacement) Then
            If UBound(elements_de_remplacement) <> UBound(elements_de_remplacement) Then SUBSTITUEX = "notEqualBoundary": Exit Function
            Q = elements_de_remplacement(I)
        Else: Q = elements_de_remplacement
        End If
        T = Replace(T, elements_a_remplacer(I), Q)
    Next
    SUBSTITUEX = T
End Function

Function GetdimensionTypeArray(T)
'Fonction pour determiner le type de dimensionnement de la variable injectée(T)
'patricktoulon
    Dim Tx, x&, Z, x2, z2&
    z2 = UBound(T): If z2 = 0 Then x2 = Z + 1: x = x2 Else x = Z: x2 = x
    Z = Switch(z2 = 1, "ligne", TypeName(Application.Index(T, z2, 2)) <> "Error", "tableau", x = x2, "vertical", x < x2 Or x > 1, "array")
    If Z = "vertical" And TypeName(Application.Index(T, z2, 1)) = "Error" Then Z = "array"
    GetdimensionTypeArray = Z
End Function


Sub UnregisterOptions()
    On Error Resume Next
    Application.MacroOptions Macro:="SUBSTITUEX", Description:=Empty, ArgumentDescriptions:=Empty, Category:=Empty
    On Error GoTo 0
End Sub

Sub registerOptions()
    Dim Funct_description As String, argumtsArray

    '(max 255 caracteres)
    Funct_description = "Fonction SUBSTITUEX" & vbCrLf & _
                        "Cette fonction sert a substituer" & vbCrLf & _
                        "Array;une chaine/carateres" & vbCrLf & "    par" & vbCrLf & _
                        "Array;une chaine/carateres ou un melange" & vbCrLf & _
                        "Creted by patricktoulon"

    'Description des arguments de la fonction
    argumtsArray = Array("string:chaine à traiter", _
                         "array de chaine ou de carateres  à substituer ((peut etre une Range))", _
                         "array de chaine ou de caratères de remplacecement ((peut etre une Range))")


    'appel  la sub pour enregistrer
    Application.MacroOptions Macro:="SUBSTITUEX", _
                             Description:=Mid(Funct_description, 1, 255), _
                             ArgumentDescriptions:=argumtsArray, _
                             Category:="personnalisée"
End Sub

démo formules affichées

démo formulaire fonction

démo quand les formules ont opéré

Enjoy

 

[dashali]

UnregisterOptions() doesn't work.

 

[eriiic]

Bonjour,

+1 pour l'idée.
Tu devrais autoriser des numériques dans le 1er array qui donnerait le code ASCII du caractère à remplacer.
Je pense principalement au code 160 bien sûr ;-)
Ca fait un test en plus qui va la ralentir mais ça élargit son champ d'application.

Et comme j'ai l'impression que tu ne retournes jamais de valeur d'erreur et que c'est une fonction chaine tu pourrais la typer String
eric

 

[patricktoulon]

Bonjour @eriiic
en voila une idée intéressante

'***************************************************************
' fonction de SUBSTITUEX (homolgue la fonction native "SUBSTITUE"
' auteur :patricktoulon
' date 08/06/2021
' version 1.0
' commentaires:
' Cette fonction sert a substituer  un/des (caractères/ partie de chain) par un/des (caractères /partie de chaine) ou un mélange
' elle a pour vocation de diminuer le script des formules imbuvable quand trop de substitue
' quand elle est plusieurs fois utilisée dans une formule
'
' mise ajour
' version 1.2
' date 19/02/2022
' renommage des arguments(plus explicites)
' les arguments peuvent maintenant etre  aussi des Ranges (1 ligne/x colonnes) ou (x lignes / 1 colonne)
' adjonction de la fonction (( GetdimensionTypeArray  ))
' cette fonction  me permet de déterminer (si /et) comment je ramène les arguments a un simple array 1 dim
' ajout de la macro description
'*************************************************************
Option Explicit
Function SUBSTITUEX(T As String, ByVal elements_a_remplacer As Variant, Optional ByVal elements_de_remplacement As Variant = "")
    Dim I&, Q$

    'conversion en variable tableau si Typerange
    If Not IsArray(elements_a_remplacer) Then elements_a_remplacer = Array(elements_a_remplacer)
     If Not IsArray(elements_de_remplacement) Then elements_de_remplacement = Array(elements_de_remplacement)
  
    elements_a_remplacer = elements_a_remplacer
    elements_de_remplacement = elements_de_remplacement

    'conversion en array 1 dimension selon le type d'array injecté
    Select Case GetdimensionTypeArray(elements_a_remplacer)
    Case "vertical": elements_a_remplacer = Application.Transpose(elements_a_remplacer):
    Case "ligne": elements_a_remplacer = Application.Index(elements_a_remplacer, 1, 0)
    End Select

    Select Case GetdimensionTypeArray(elements_de_remplacement)
    Case "vertical": elements_de_remplacement = Application.Transpose(elements_de_remplacement)
    Case "ligne": elements_de_remplacement = Application.Index(elements_de_remplacement, 1, 0)
    End Select

    For I = LBound(elements_a_remplacer) To UBound(elements_a_remplacer)
        If IsNumeric(elements_a_remplacer(I)) Then elements_a_remplacer(I) = Chr(Val(elements_a_remplacer(I)))
        If IsArray(elements_de_remplacement) Then
            If UBound(elements_de_remplacement) <> UBound(elements_de_remplacement) Then SUBSTITUEX = "notEqualBoundary": Exit Function
            If IsNumeric(elements_de_remplacement(I)) Then elements_de_remplacement(I) = Chr(Val(elements_de_remplacement(I)))
            Q = elements_de_remplacement(I)
        Else: Q = elements_de_remplacement
        End If
        T = Replace(T, elements_a_remplacer(I), Q)
    Next
    SUBSTITUEX = T
End Function

tu peux le faire maintenant

 

[eriiic]

Bonjour Patrick,
Merci mais je n'en ai pas vraiment besoin.
Le plus souvent ce n'est que 2 voire 3 caractères que je dois changer.
Mais je note dans un coin son existence pour quand le besoin sera là
Bonne fin de we
eric