VBA Si trouve une valeur Copie le reste du texte et boucle [Résolu/Fermé]

Messages postés
44
Date d'inscription
mardi 16 février 2016
Statut
Membre
Dernière intervention
18 mars 2016
- - Dernière réponse : Styla27
Messages postés
44
Date d'inscription
mardi 16 février 2016
Statut
Membre
Dernière intervention
18 mars 2016
- 24 févr. 2016 à 17:30
Bonjour,

Pour commencer, je n'ai pas de fichier Excel à donner car très confidentiel.
J'ai besoin de votre aide svp et cette fois, c'est urgent ! Je ne trouve pas de réponse.

Ma cellule A135 de la feuille ORI2 =
Sheets("ORI2").Range("A135")

comporte un texte TROP LONG avec plusieurs fois la valeur ORI (suivi d'un chiffre).


Exemple :
ORI2 : La limite de caractères pour Twitter est 140. Un message texto SMS peut avoir jusqu'à 160 caractères. Les ponctuations = compter comme caractère.

ORI4 : Simplement limité à ça

ORI9 : Si tu savais lôngin

ORI13 : La limite de caractères pour Twitter est 140. Un message texto SMS peut avoir jusqu'à 160 caractères. Les ponctuations = compter comme caractère.

ORI1 à pouvant aller jusqu'à plus de ORI400...

DONC ce dont j'ai besoin
J'ai besoin d'une formule VBA pour qu'à chaque mot ORIXXX
que le texte se copie dans la cellule du bas, ainsi de suite !
(redimension de cellule si nécessaire)


SVP help, je n'ai pas du tout la maîtrise d'Excel et j'ai essayé de passer par plusieurs formules trouvées sur Internet (nombre de caractères...)

Je décourage mais je ne peux abandonner, c'est pour mon boulot !


Info facultative, je suis passée par ce genre de codes mais ça ne va pas du tout, ça coupe de partout :

Nombre de caractère avec le mot ORI
Sub maxi()
Dim x As Integer
'+10 pour etendre la zone de boucle ou + 20, peu importe, sinon la derniere ligne
'créer par VBA ne fait pas partie de la plage de calcul
For Each cell In Range("A135:A" & [A65000].End(xlUp).Row + 50)
If Len(cell) > 200 Then
For x = 1 To 20
If Mid(cell, 230 - x, 1) = "*ORI*" Then Exit For
Next x

cell.Offset(1, 0).EntireRow.Insert
cell.Offset(1, 0) = Right(cell, Len(cell) - 200 + x)
cell.Value = Left(cell.Value, 200 - x)
End If
Next cell
End Sub


ou encore saut de cellules à chaque nombre de caractères.
Sub Test()
MaLigne = 135 'premiere ligne a decortiquer
SuiteL = 137 'ligne de la cellule ou poser les caracteres

Caractere = Val(InputBox("Conseil : Environ 160 caractères pour 2 lignes de commentaires", "Indiquez le nombre de caractère que peut contenir une cellule"))
If Caractere = 0 Then Exit Sub

MaxLigneVide = 1 'defini apres combien de lignes trouvees vide la procédure s'arrete
Compteur = 0

Do While Compteur < MaxLigneVide
If Cells(MaLigne, 1).Value = "" Then Compteur = Compteur + 1 Else Compteur = 0
For y = 1 To Len(Cells(MaLigne, 1).Value) 'pour tous les caracteres de la cellule
Cells(SuiteL, 1).Value = Cells(SuiteL, 1).Value & Mid(Cells(MaLigne, 1).Value, y, 1)
If y Mod Caractere = 0 Then SuiteL = SuiteL + 1 'si le nb de caractere =Xnombre, incremente la ligne de destination
Next y
SuiteL = SuiteL + 1
MaLigne = MaLigne + 1
Loop

'Sheets("ORI2").Range("A135").ClearContents
End Sub


ou la fusion de cellule qui ne marche pas, mais c'est pas bon non plus cette technique (car trop peu d'options) :
Sub Fusionner()
Dim i, Fin, Fin2 As Integer

Fin = 159
i = 135
Fin2 = 187

If Sheets("ORI2").Cells(i, 1).Value <> "" Then
If Len(Cells(i, 1) < 1400) Then

'Fusionne et formatte
Range(Cells(i, 1), Cells(Fin, 1)).Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = True
End With
Selection.Merge

ElseIf Sheets("ORI2").Cells(i, 1).Value <> "" And Len(Cells(i, 1) > 1400) Then


'Fusionne et formatte
Range(Cells(i, 1), Cells(Fin2, 1)).Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = True
End With
Selection.Merge

End If
End If
End Sub


MERCI d'avance de votre aide





Afficher la suite 

2 réponses

Meilleure réponse
Messages postés
14680
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
21 août 2019
1165
1
Merci
Bonjour,

je n'ai pas de fichier Excel à donner Si, vous pouvez faire une maquette avec vos ORI et des infos bidons, mais que ce soit representatif de la realite et les textes que vous voulez voir ecrits correctement

Dire « Merci » 1

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 58864 internautes nous ont dit merci ce mois-ci

Styla27
Messages postés
44
Date d'inscription
mardi 16 février 2016
Statut
Membre
Dernière intervention
18 mars 2016
-
Bonjour et merci d'avance de votre aide. Je prépare ça de suite. Merci
Styla27
Messages postés
44
Date d'inscription
mardi 16 février 2016
Statut
Membre
Dernière intervention
18 mars 2016
-
RESUME DE LA REPONSE
pour d'autres internautes, trouvée par f894009 (Encore 1 fois merci !)

Problème de la cellule A135 (texte trop long) à découper sur plusieurs cellules du dessous (toujours de la colonne A) grâce au mot "ORI"

Sub Transpose()
Dim Plage As Range
Dim DCNV As Long
Dim TInfos_Dec()

With Worksheets("ORI2")
Set Plage = .Range("A135:A" & .Range("A" & Rows.Count).End(xlUp).Row) 'mise en memoire Plage de cellules
P = -1 'initialisation Pointeur Tableau cellules decoupees
For Each cell In Plage
TInfos = Split(cell, "ORI") 'decoupage cellule dans un tableau
For x = 1 To UBound(TInfos)
P = P + 1
ReDim Preserve TInfos_Dec(P) 'redimensione le tableau en conservant les valeurs deja acquisent
TInfos_Dec(P) = "ORI" & Left(TInfos(x), Len(TInfos(x)) - 2) 'mise en tableau des infos decoupees
Next x
Next cell
.Range("A135").Resize(UBound(TInfos_Dec) + 1) = Application.Transpose(TInfos_Dec) 'restitue les infos
DCV = .Range("A" & Rows.Count).End(xlUp).Row
.Rows("135:" & DCV).EntireRow.AutoFit
.Columns("A:A").EntireColumn.AutoFit 'Pour redimensionner niveau largeur
End With
End Sub



Vous m'avez sauvé :D
Messages postés
15905
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
17 août 2019
2780
Styla27
Messages postés
44
Date d'inscription
mardi 16 février 2016
Statut
Membre
Dernière intervention
18 mars 2016
-
Bonjour Michel_m,
Ce n'est pas un doublon de sujet, ça n'a rien à voir.
J'essaye de trouver une solution via différents moyens. Pourquoi vous êtes "agressifs" ?
Je suis dans l'incapacité de trouver une solution et l'autre sujet n'est même pas résolu !