Scinder celulle en 30 caractères

[Dorian10000]

Bonjour le forum,

Je sèche depuis un petit moment pour scinder plusieurs cellules Excel en cellules de 30 caractères.
Je souhaite tenir compte des Chr(10) également.
Il faut aussi que je ramène d'autres infos.

Je met un fichier qui montre ce que je souhaite en résultat final.

Merci d'avance pour votre aide.

 

[Dranreb]

Re : Scinder celulle en 30 caractères

Bonjour.
Cette fonction VBA calcule et renvoie le tableau souhaité :

Function Scindé(ByVal R As Range) As Variant()
Dim TDon(), Ld&, TSpl() As String, S&, Z As String, Ls&, TRés(), N&
TDon = R.Value
For Ld = 1 To UBound(TDon)
   TSpl = Split(TDon(Ld, 2), vbLf)
   For S = 0 To UBound(TSpl)
      Z = TSpl(S)
      While Len(Z) > 0
         Ls = Ls + 1: Z = Mid$(Z, 31): Wend: Next S, Ld
ReDim TRés(1 To Ls, 1 To 3): Ls = 0
For Ld = 1 To UBound(TDon)
   TSpl = Split(TDon(Ld, 2), vbLf): N = 0
   For S = 0 To UBound(TSpl)
      Z = TSpl(S)
      While Len(Z) > 0
         Ls = Ls + 1: TRés(Ls, 1) = TDon(Ld, 1): TRés(Ls, 2) = Left$(Z, 30): N = N + 1: TRés(Ls, 3) = N
         Z = Mid$(Z, 31): Wend: Next S, Ld
Scindé = TRés
End Function

Tester par formule matricielle sur 9 lignes et 3 colonnes :

=Scindé($A$2:$B$3)

validé par Ctrl+Maj+Entrée

 

[Dorian10000]

Re : Scinder celulle en 30 caractères

Merci Dranreb pour votre retour,

mais la fonction ne renvoi que toto même en la validant avec Ctrl+Maj+Entrée.
J'ai mis le code dans un module.

merci pour votre aide.

 

[Dranreb]

Re : Scinder celulle en 30 caractères

C'est ce que j'aurais eu aussi si je l'avais validé sur un seule cellule au lieu d'une plage rectangulaire de 9 lignes et 3 colonnes.
N'est-ce pas ce que vous avez fait ? Si oui sélectionnez toute la plage, cliquez dans la barre de formule, revalidez en matriciel

 

[job75]

Re : Scinder celulle en 30 caractères

Bonjour Dorian10000, bienvenue sur XLD, salut Bernard,

Avec des tableaux VBA c'est très rapide même sur un grand nombre de lignes :

Sub Coupichonner()
Dim coupe%, tablo, i&, num%, x, s, j%, k%, n&, t(), rest()
coupe = 30 'longueur à adapter
tablo = [A1].CurrentRegion.Offset(1).Resize(, 2) 'à adapter
For i = 1 To UBound(tablo)
  num = 0
  x = tablo(i, 1)
  s = Split(tablo(i, 2), vbLf)
  For j = 0 To UBound(s)
    For k = 1 To Len(s(j)) Step coupe
      n = n + 1: num = num + 1
      ReDim Preserve t(1 To 3, 1 To n)
      t(1, n) = x
      t(2, n) = Mid(s(j), k, coupe)
      t(3, n) = num
Next k, j, i
'---transposition---
ReDim rest(1 To n, 1 To 3)
For i = 1 To n
  rest(i, 1) = t(1, i)
  rest(i, 2) = t(2, i)
  rest(i, 3) = t(3, i)
Next i
'---restitution---
[A2].Resize(n, 3) = rest
End Sub

Fichier joint.

A+

 

[job75]

Re : Scinder celulle en 30 caractères

Re,

En ligne 8 la restitution donne un espace devant "sur".

On peut bien sûr supprimer les espaces situés avant ou après la coupure :

t(2, n) = Trim(Mid(s(j), k, coupe))

Fichier (2).

A+

 

[job75]

Re : Scinder celulle en 30 caractères

Re,

Si l'on veut éviter un bug quand le tableau est vide ajouter une ligne :

Next k, j, i
If n = 0 Then Exit Sub 'si le tableau est vide
'---transposition---

Bonne soirée.