Macro pour découper chaine en "morceaux" de 255 caractères

océanne

XLDnaute Occasionnel
Bonjour à tous,

Je cherche par macro à découper une chaine de caractères suivant certains critères spécifiés dans mon fichier en annexe.

Merci pour votre aide

Océanne
 

Pièces jointes

  • Macro découper chaine caractères.xlsx
    10 KB · Affichages: 141

camarchepas

XLDnaute Barbatruc
Re : Macro pour découper chaine en "morceaux" de 255 caractères

Bonjour,

je pense qu'il faut tenir compte d'un caractere de découpage , non ... l'espace peut être ?

bon en attendant, vooici un début de solution

Code:
Sub coupe()
Dim Longueur As Long, Tourne As Long, Colonne As Long
Dim phrase As String

Colonne = 2
phrase = Range("A2")
Longueur = Len(phrase)
For Tourne = 1 To Longueur Step 255
  Cells(2, Colonne) = Mid(phrase, Tourne, 255)
  Colonne = Colonne + 1
Next Tourne
End Sub
 

ROGER2327

XLDnaute Barbatruc
Re : Macro pour découper chaine en "morceaux" de 255 caractères

Bonjour à tous.


Un autre essai.
La fonction hache(texte$, ParamArray coupure()) prend une chaîne de caractères texte$ et une liste optionnelle de chaînes de longueur 1 (coupure()).
  • S'il y a des paramètres optionnels, la fonction essaie de couper la chaine sur l'un des paramètres, en s'approchant au mieux de segments de 255 caractères. En cas d'impossibilité, elle coupe par tranches de 255 caractères.
    Par exemple, hache(chaîne de caractères, " ", "-", Chr(10)) tentera de couper le texte après une espace, un tiret ou un paragraphe.
  • S'il n'y a aucun paramètre optionnel, la fonction découpe le texte par tranches de 255 caractères.

La fonction renvoie une matrice uni-ligne contenant les segments de texte.​
Code:
Function hache(texte$, ParamArray coupure())
Const l% = 255
Dim i%, x%, y%, z%, v$()
ReDim v(0)
  If UBound(coupure) < 0 Then coupure = Array(ChrW(&HFEFF))
  Do While Len(texte) > l
    z = 0
    For i = 0 To UBound(coupure)
      x = -(Left$(texte, 1) = coupure(i))
      Do
        y = x: x = x + 1: x = InStr(x, texte, coupure(i))
      Loop Until x = 0 Or x > l
      If y > z Then z = y: If z = l Then Exit For
    Next
    If z = 0 Then z = l
    v(UBound(v)) = Mid$(texte, 1, z)
    texte = Mid$(texte, z + 1, Len(texte))
    ReDim Preserve v(UBound(v) + 1)
  Loop
  v(UBound(v)) = texte
  hache = v
End Function
Dans le classeur joint, deux procédures mettent en œuvre la fonction hache :​
VB:
Sub saucissonne()
Dim i%, x
  With Selection(1)
    x = hache(.Text, " ", "-", Chr(10))
    i = UBound(x) + 1
    With Application: .ScreenUpdating = 0: .EnableEvents = 0: .Calculation = -4135: End With
    With .Offset(0, 1)
      .Resize(1, i).Value = x
      Do Until .Offset(0, i).Text = "": .Offset(0, i).Value = "": i = i + 1: Loop
    End With
    With Application: .Calculation = -4105: .EnableEvents = 1: .ScreenUpdating = 1: End With
  End With
End Sub
VB:
Sub massacre()
Dim i%, x
  With Selection(1)
    x = hache(.Text)
    i = UBound(x) + 1
    With Application: .ScreenUpdating = 0: .EnableEvents = 0: .Calculation = -4135: End With
    With .Offset(0, 1)
      .Resize(1, i).Value = x
      Do Until .Offset(0, i).Text = "": .Offset(0, i).Value = "": i = i + 1: Loop
    End With
    With Application: .Calculation = -4105: .EnableEvents = 1: .ScreenUpdating = 1: End With
  End With
End Sub
Si le classeur joint ne permet pas de comprendre tout ça, dites-le !​


Bonne journée.


ℝOGER2327
#7714


Mercredi 18 Décervelage 142 (Saints Pirates et Flibustiers, thaumaturges - fête Suprême Quarte)
26 Nivôse An CCXXIII, 5,4630h - étain
2015-W03-4T13:06:41Z
 

Pièces jointes

  • Découper un texte.xlsm
    21.6 KB · Affichages: 63
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
299 850
Messages
1 979 570
Membres
206 780
dernier inscrit
Edwige81