Ne pas dépasser 72 caractères dans une cellule

Bonsoir à Tous,

J'ai besoin d'un gros coup pouce sur ce coup là, en VBA.

En colonne "AH" le texte ne doit pas dépasser 72 caractères. Le reste des caractères restant, doivent être inséré en dessous de la ligne avec les lignes avant et après la colonne "AH".

Les mots ne doivent pas être tronqué. L'arrêt doit se faire sur un espace.

Le fichier original contient environ 53,000 lignes.

Je joins un fichier exemple avec le résultat voulu pour mieux expliquer ce que j'ai besoin.

J'espère que c'est faisable...

Merci

Jean

Bonjour,

À 53,000 lignes, je crois que tu vas être bon pour aller luncher avant la fin.

Le traitement commence à la dernière ligne de AH et remonte jusqu'à la ligne 2.

Dans mon test, j'ai fait écrire en AG la longueur du texte de AH. Aucune ligne ne dépasse 72, toujours avec les coupures sur une espace.

J'ai désactivé l'écriture en AG car ça écrasait des données.

À tester chrono en main ....

Gelinotte

Bonjour Gelinotte,

Coup de MAÎTRE, ça fonctionne très bien.

Pour traiter les 53,474 lignes dans le fichier, ça pris 4 minutes, qui me donne à la fin de la procédure: 61,908 lignes.

Pour compléter, êtes vous en mesure de m'écrire un bout de code pour enlever tous les espaces au début de chaque cellule.

Voir Photo comme exemple.

Un TRÈS GROS MERCI.

Jean

Bonjour Gelinotte,

Rectification:

Pour traiter les 53,474 lignes dans le fichier, ça pris 4 minutes, qui me donne à la fin de la procédure: 61,908 lignes.

Je du le faire en tranche de 25,000 lignes, car les 53,000 lignes me donnais comme erreur "Dépassement de Capacité".

Donc, pour faire les 25,000 lignes ça pris 4 minutes, qui me donne à la fin de la procédure: 61,908 lignes.

Voila pour la Rectification.

Jean

Bonjour,

J'ai ajouté 2 fois au cas où il y aurait 2 espaces :

If Left(chaine, 1) = " " Then chaine = Right(chaine, Len(chaine) - 1) ''' si le 1er caractère est " " ...

If Left(chaine, 1) = " " Then chaine = Right(chaine, Len(chaine) - 1) ''' si le 1er caractère est " " ... Au cas d'une 2e espace

Gelinotte

Bonsoir Gelinotte,

Ça fonctionne, mais ça ralenti la procédure. J'ai du l'arrêter car c'était trop long.

Y a t'il un moyen de faire rouler la macro indépendamment de l'autre.

i.e. est-ce que je peux la faire rouler après que l'autre soit terminé.

Genre un Sub juste pour enlever l'espace en début de cellule.

ex:

Sub oter_espace()

If Left(chaine, 1) = " " Then chaine = Right(chaine, Len(chaine) - 1) ''' si le 1er caractère est " " ...

If Left(chaine, 1) = " " Then chaine = Right(chaine, Len(chaine) - 1) ''' si le 1er caractère est " " ... Au cas d'une 2e espace

End Sub

Merci Gelinotte pour votre AIDE.

Jean

Bonjour,

Oui, comme ceci ...

Sub Oter_Espace()
Dim Derlig As Long
Dim X As Long
Application.ScreenUpdating = False

Derlig = Range("AH" & Rows.Count).End(xlUp).Row
For X = 1 To Derlig
    If Left(Cells(X, "AH"), 1) = " " Then Cells(X, "AH") = Right(Cells(X, "AH"), Len(Cells(X, "AH")) - 1) ''' si le 1er caractère est " " ...
    If Left(Cells(X, "AH"), 1) = " " Then Cells(X, "AH") = Right(Cells(X, "AH"), Len(Cells(X, "AH")) - 1) ''' si le 1er caractère est " " ...
Next X
Application.ScreenUpdating = True
End Sub

Gelinotte

Bonjour Gelinotte,

Ça fait la job. La macro roule environ 10 secondes.

Un TRÈS GROS MERCI, je ferme le sujet avec une grande satisfaction.

Jean