70 caractère dans un ecellule a mettre dans 3 cellule Résolu/Fermé

Question

Bonsoir,

J'ai un fichier excel avec une dénomination produit de 70 caractères

Exemple: SAC 50L ROUGE A OUVERTURE SOLUBLE EAU FROIDE 30µ x 200

Je dois passer cette dénomination dans trois cellules, 
chacune pouvant contenir que 30 caractères 
et ce, sans couper de mot.

Exemple du résultat attendu :

1ère cellule:   SAC 50L ROUGE A OUVERTURE
2ème cellule: SOLUBLE EAU FROIDE 30µ x 200
3ème cellule:
Rien dans la 3ème cellule car la dénomination ne dépasse pas les 60 caractères.

Comment dois-je m'y prendre .

j'ai près de 4 000 lignes à réaliser

Merci pour votre aide urgente

ccm81 · Answer

Bonjour

Un exemple rapide avec macro (à tester)
http://www.cjoint.com/c/GDlqw2D8qjs

Cdlmnt

gbinforme · Answer

Bonjour à tous, 

Je t'ai mis trois méthodes pour résoudre ton projet :

1) méthode excel formule
En B2 
=STXT($A2;1;SI(NBCAR($A2)<30;NBCAR($A2);TROUVE(" ";SUBSTITUE(STXT($A2;1;30);" ";" ";30-NBCAR(SUBSTITUE(STXT($A2;1;30);" ";""))))-1)) 
En C2 
=STXT($A2;2+NBCAR($B2);SI(NBCAR(STXT($A2;1+NBCAR($B2);30))<30;NBCAR(STXT($A2;1+NBCAR($B2);30));CHERCHE(" ";SUBSTITUE(STXT(STXT($A2;2+NBCAR($B2);30);1;30);" ";" ");NBCAR(SUBSTITUE(STXT(STXT($A2;2+NBCAR($B2);30);1;30);" ";""))-5))) 
En D2
=STXT($A2;2+NBCAR($B2)+NBCAR($C2);20) 
2) formule personnalisée vba
Public Function découpe(cel As Range, elm As Integer)
Dim col As Long, lds As Long, pos As Long
    pos = 1: lds = 0
    For col = 1 To elm
        pos = pos + lds
        If Len(Mid(cel, pos)) < 30 Then
            lds = Len(Mid(cel, pos))
        Else
            lds = InStrRev(Mid(cel, pos, 30), " ")
        End If
    Next col
    découpe = Mid(cel, pos, lds)
End Function
Pour l'appeler formule à tirer sur toute la plage résultat=découpe($A2;COLONNE()-1)
3) macro VBA comme ccm81 que je salue
Public Sub découpe_gb()
Const deb As Long = 2, clt  As Long = 1
Dim col As Long, der As Long, lds As Long, lig As Long, pos As Long, tbd
der = Cells(Rows.Count, clt).End(xlUp).Row
lig = der - deb + 1
tbd = Cells(deb, clt).Resize(lig, 1).Value
ReDim tbr(1 To lig, 1 To 3)
For lig = 1 To UBound(tbd)
  pos = 1
  For col = 1 To 3
    If Len(Mid(tbd(lig, 1), pos)) < 30 Then
        tbr(lig, col) = Mid(tbd(lig, 1), pos)
        pos = pos + Len(tbr(lig, col))
    Else
      lds = InStrRev(Mid(tbd(lig, 1), pos, 30), " ")
      tbr(lig, col) = Mid(tbd(lig, 1), pos, lds - 1)
      pos = pos + lds
    End If
  Next col
Next lig
Cells(deb, clt + 1).Resize(UBound(tbr), UBound(tbr, 2)) = tbr
End Sub

Le classeur exemple : https://www.cjoint.com/c/GDmiFFatTNl
--Toujours zen
La perfection est atteinte, non pas lorsqu'il n'y a plus rien à ajouter, mais lorsqu'il n'y a plus rien à retirer.  Antoine de Saint-Exupéry

70 caractère dans un ecellule a mettre dans 3 cellule

2 réponses

Discussions similaires