XL 2013 encadré les parties entre guillemet de texte avec caractère particulier

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

patricktoulon

XLDnaute Barbatruc
bonjour à tous je cherche un moyen de faire proprement l'encadrement departie entre guillement de texte

texte original

VB:
Sub test()
    If toto = " ' "" tutu """ And dodo = "" Then
        If toto = 10 And tutu = " "" taratata "" " Then
            tutu = "toto & """" & dada & """" " & """""turlututu"""""
        End If
    End If
End Sub

résultat souhaité le caractère est le "|"
Sub test()
If toto = |" ' "" tutu """ | And dodo = |""| Then
If toto = 10 And tutu = |" "" taratata "" "| Then
tutu = |"toto"| & |""""| & dada & |"""" "| & |"""""turlututu"""""|
End If
End If
End Sub
merci pour vos retours
 
Solution
Bonsoir à tous,

La p'tite fonction VBA à ma pomme :
VB:
Function Encadrer$(ByVal texte$)
Dim gui$, gui2$, res$, i&, n&, cpt&, c$, cc$
   gui = """"
   n = InStr(texte, gui)
   If n = 0 Then Encadrer = texte: Exit Function
   cpt = 1: res = Left(texte, n - 1) & "|" & gui
   For i = n + 1 To Len(texte)
      c = Mid(texte, i, 1): cc = Mid(texte, i + 1, 1)
      If c <> gui Then
         res = res & c
      Else
         If cpt = 0 Then
            res = res & "|" & gui: cpt = 1
         Else
            If cc = gui Then
               res = res & gui & gui: i = i + 1
            Else
               res = res & gui & "|": cpt = 0
            End If
         End If
      End If
   Next i
   Encadrer = res
End Function
Bonsoir patricktoulon, le forum,

Ta ligne tutu = "toto & """" & dada & """" " & """""turlututu""""" ne contenant que deux segments de texte, ne devrait-elle pas donner ça pour résultat : tutu = |"toto & """" & dada & """" "| & |"""""turlututu"""""| ?
Si c'est bien le cas, tu trouveras un essai ci-dessous :
VB:
Sub test()
Const separateurImprobable As String = "~#'@¤%µ*"
Dim t As String, i As Long, flagStr As Long, res As String
    
    't = "    If toto = "" ' """" tutu """""" And dodo = """" Then"
    t = "tutu = ""toto & """""""" & dada & """""""" "" & """"""""""turlututu"""""""""""
       
    For i = 1 To Len(t)
        If Mid(t, i, 1) = """" Then
            If Not flagStr Then
                res = res & separateurImprobable & """"
            Else
                res = res & """" & separateurImprobable
            End If
            flagStr = Not flagStr
        Else
            res = res & Mid(t, i, 1)
        End If
    Next i
    
    res = Replace(res, """" & separateurImprobable & separateurImprobable & """", """""")
    res = Replace(res, separateurImprobable, "|")
    
    Debug.Print t
    Debug.Print res
    
    
End Sub

A+
 
Bonsoir à tous,

La p'tite fonction VBA à ma pomme :
VB:
Function Encadrer$(ByVal texte$)
Dim gui$, gui2$, res$, i&, n&, cpt&, c$, cc$
   gui = """"
   n = InStr(texte, gui)
   If n = 0 Then Encadrer = texte: Exit Function
   cpt = 1: res = Left(texte, n - 1) & "|" & gui
   For i = n + 1 To Len(texte)
      c = Mid(texte, i, 1): cc = Mid(texte, i + 1, 1)
      If c <> gui Then
         res = res & c
      Else
         If cpt = 0 Then
            res = res & "|" & gui: cpt = 1
         Else
            If cc = gui Then
               res = res & gui & gui: i = i + 1
            Else
               res = res & gui & "|": cpt = 0
            End If
         End If
      End If
   Next i
   Encadrer = res
End Function
 

Pièces jointes

Bonjour @mapomme
il y avait une erreur dans mon enoncé que j'ai corrigé
VB:
Sub test()
    If toto = " ' "" tutu """ And dodo = "" Then
        If toto = 10 And tutu = " "" taratata "" " Then
            tutu = "toto" & """" & dada & """"" " & """""turlututu"""""
        End If
    End If
titi = """tata"""
If tutu = """""""taratata""""""" Then machin = " '"" " & truc & " "" ' "

End If
mais ton code a l'air de parfaitement fonctionner
 
Bonjour patricktoulon, mapomme, le forum,

@patricktoulon :
Du coup, je ne sais pas si tu as testé mon code...

De mon côté je l’ai fait, et sur les exemples que tu as fourni il renvoie les même résultats que celui de mapomme.
C’est la deuxième fois où je réponds à une de tes questions, et la deuxième fois où j’ai l’impression de "nager dans le vide". Pas cool.

A+
 
si bien sur je l'ai testé il fonctionne aussi dans le même exemple que celui utilisé avec le code de @mapomme
Sub test()
If toto = " ' "" tutu """ And dodo = "" Then 'commentaire "de ligne"
'ligne de commentaire
If toto = 10 And tutu = " "" taratata "" " Then
tutu = "toto" & """" & dada & """"" " & """""turlututu"""""
End If
End If
titi = """tata"""
If tutu = """""""taratata""""""" Then machin = " '"" " & truc & " "" ' "
bidule = """ ' ' " & """" & chose & " ' ' """
End If


Sub test()
If toto = |" ' "" tutu """| And dodo = |""| Then 'commentaire |"de ligne"|
'ligne de commentaire
If toto = 10 And tutu = |" "" taratata "" "| Then
tutu = |"toto"| & |""""| & dada & |""""" "| & |"""""turlututu"""""|
End If
End If
titi = |"""tata"""|
If tutu = |"""""""taratata"""""""| Then machin = |" '"" "| & truc & |" "" ' "|
bidule = |""" ' ' "| & |""""| & chose & |" ' ' """|
End If
mille excuses de ne pas avoir répondu
Bravo a tout les deux
le code de @mromain a l'air plus simple
par contre celui de @mapomme au benchmark il est plus rapide
en effet tu utilise 2 replace (ce qui est gourmand en vba) après avoir ré écrit le text (res)
tandis que @mapomme réécrit le texte seulement
sur cet exemple ca se voit pas mais sur le code complet d'un module on voit tres clairement une différence de vitesse d'execution
 
Dernière édition:
pour vous donner une idée de ce que je fait
je créé des embed code html avec coloration syntaxique
demo3.gif
 
Bonjour,
Une approche peut-être :

VB:
Sub ModifierModuleAvecBarres()
    Dim comp As Object, modName As String, code As String
    Dim lignes() As String, ligne As String, newLigne As String
    Dim i As Long
    
    modName = InputBox("Nom du module à modifier (ex: Module1)", "Encadrement de chaînes")
    If modName = "" Then Exit Sub

    On Error Resume Next
    Set comp = ThisWorkbook.VBProject.VBComponents(modName)
    If comp Is Nothing Then
        MsgBox "Module introuvable.", vbCritical
        Exit Sub
    End If
    On Error GoTo 0

    code = comp.CodeModule.Lines(1, comp.CodeModule.CountOfLines)
    lignes = Split(code, vbNewLine)
    
    comp.CodeModule.DeleteLines 1, comp.CodeModule.CountOfLines

    For i = 0 To UBound(lignes)
        newLigne = EncadrerGuillemets(lignes(i))
        comp.CodeModule.InsertLines comp.CodeModule.CountOfLines + 1, newLigne
    Next i

    MsgBox "Module '" & modName & "' modifié avec succès.", vbInformation
End Sub

Function EncadrerGuillemets(texte As String) As String
    Dim i As Long
    Dim c As String
    Dim dansChaine As Boolean
    Dim buffer As String
    Dim resultat As String

    i = 1
    Do While i <= Len(texte)
        c = Mid(texte, i, 1)
        
        If c = """" Then
            buffer = buffer & c
            If i < Len(texte) And Mid(texte, i + 1, 1) = """" Then
                buffer = buffer & """"
                i = i + 1
            Else
                If dansChaine Then
                    resultat = resultat & "|" & buffer & "|"
                    buffer = ""
                    dansChaine = False
                Else
                    dansChaine = True
                    buffer = """"
                End If
            End If
        Else
            If dansChaine Then
                buffer = buffer & c
            Else
                resultat = resultat & c
            End If
        End If
        i = i + 1
    Loop
    EncadrerGuillemets = resultat
End Function
 
bonjour

la solution c'est la même que @mromain
voir même un mixte des deux puis que tu utilise un flag 'buffer' mais ajoute directement le caractère d'encadrement
du coup le flag sert un peu a rien
et qui puis est au benchmark elle est a peine un peu plus longue que la version de @mromain

changer le packaging d'un produit n'en fait pas un autre produit

j'ai adopté et adapté la solution de @mapomme
VB:
Const dbG = "©"
Const fiG = "®"
'===========================================================================================================
' ///////////////////////////////Fonction pour mettre des caractères de repère//////////////////////////////
'                               (avant et apres les expressions entre guillemets
'-----------------------------------------------------------------------------------------------------------
Function Encadrer2$(ByVal Texte$)
    Dim gui$, gui2$, res$, i&, n&, cpt&, c$, cc$
    'collaborateur :
    '@mapomme
    '@mromain
    gui = """"
    n = InStr(Texte, gui)
    If n = 0 Then
        Encadrer2 = Texte
        Exit Function
    End If
    cpt = 1
    res = Left(Texte, n - 1) & dbG & gui
    For i = n + 1 To Len(Texte)
        c = Mid(Texte, i, 1): cc = Mid(Texte, i + 1, 1)
        If c <> gui Then
            res = res & c
        Else
            If cpt = 0 Then
                res = res & dbG & gui
                cpt = 1
            Else
                If cc = gui Then
                    res = res & gui & gui
                    i = i + 1
                Else
                    res = res & gui & fiG
                    cpt = 0
                End If
            End If
        End If
    Next i
    Encadrer2 = res
End Function
'===========================================================================================================
 
et maintenant encore plus rapide et pour le test je test sur le module lui même
et j'ajoute même l'impression avec l'imprimante pdf windows
c'est du rapido de chez rapido
visez le travail
demo3.gif


je travail encore sur les aménagement sde saut de page en css pour qu'il y est une seule sub ou fonction par page dans le pdf
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
2
Affichages
954
Réponses
22
Affichages
4 K
Retour