Replace de masse, remplacer des chaînes par d'autres en une seule opération


Commenter

Contenu du snippet 

Function MultiReplace(ByVal Expression As String, aFind() As String, aReplace() As String) As String
    Dim i&, lPos&, UboundReplace%, sBuffer$
'   tableaux dimentionnés?
    If (Not (Not aFind)) = 0 Then MultiReplace = Expression: Exit  Function
    If (Not (Not aReplace)) = 0 Then UboundReplace = -1 Else UboundReplace = UBound(aReplace)
'   chaque élément du  tableau à chercher
    If UboundReplace = -1 Then
        For i = LBound(aFind) To UBound(aFind)
            Call MonoReplace(Expression, aFind(i),  vbNullString)
        Next i
    ElseIf UboundReplace >= UBound(aFind) Then
        For i = LBound(aFind) To UBound(aFind)
            Call MonoReplace(Expression, aFind(i),  aReplace(i))
        Next i
    Else
        For i = LBound(aFind) To UBound(aFind)
            Call MonoReplace(Expression, aFind(i),  aReplace(UBound(aReplace)))
        Next i
    End If
    MultiReplace = Expression
End Function
Sub MonoReplace(ByRef Expression As String, sFind As String, sReplace As String)
    Dim lPos&
    Do
        lPos = InStr(1, Expression, sFind)
        If lPos > 0 Then Expression = Left$(Expression, lPos - 1) & sReplace & Right$(Expression, Len(Expression) - lPos - Len(sFind) + 1)
    Loop Until lPos = 0
End Sub

'    EXEMPLE  D'UTILISATION
Private Sub Form_Load()
    Const TOTREAT As String = "Dans le pays  %%countryselected,  '%%pseudo' a déclaré la guerre ce %%date à %%time (en  %%countryselected) avec  son arme favorite : %%extraweapon."
    Dim aArgs(4) As String, aStr1(4) As String, aStr2(0) As  String
    
    aArgs(0) = "%%countryselected"
    aArgs(1) = "%%pseudo"
    aArgs(2) = "%%date"
    aArgs(3) = "%%time"
    aArgs(4) = "%%extraweapon"
    aStr1(0) = "France"
    aStr1(1) = "piti Codyx"
    aStr1(2) = Format$(Date, "DDDD DD MMM YYYY")
    aStr1(3) = CStr(Time)
    aStr1(4) = "la bible de Visual Basic ;  bien  lourde mais relativement digeste"
    
    aStr2(0) = "générique"
    MsgBox TOTREAT & vbCrLf & vbCrLf & MultiReplace(TOTREAT,  aArgs, aStr1)
    MsgBox TOTREAT & vbCrLf & vbCrLf & MultiReplace(TOTREAT,  aArgs, aStr2)
End Sub

Compatibilité : VB6, VBA

Disponible dans d'autres langages :

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (PCPT)