VBA Fusionner cellules avec plusieurs conditions et instructions

Styla27 Messages postés 44 Date d'inscription Statut Membre Dernière intervention -
f894009 Messages postés 17417 Date d'inscription Statut Membre Dernière intervention - 18 mars 2016 à 19:09

Bonsoir,

Je suis une newbie. J'essaye le VBA Excel.

Pour la cellule A135 de ma feuille ORI2.

Ce que je souhaite :
Si cellule A135 contient moins de 1400 caractères
Alors Fusionner A135 à A159
Mais si cellule A 135 contient plus de 1400 carac.
Alors fusionner A135 à 187

Mais la deuxième condition ne marche (plus de 1400 carac. pour fusionner plus de cellules)

Merci d'avance pour votre aide :)

Voici mon code :

Sub Fusionner()
    Dim i, Fin, Fin2 As Integer
    
   Fin = 159
   i = 135
   Fin2 = 187
        
        If Sheets("ORI2").Cells(i, 1).Value <> "" And 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

Afficher la suite

A voir également:

Merge vba
Mkv merge - Télécharger - Montage & Édition
Araxis merge - Télécharger - Gestion de fichiers
Merge mp3 - Télécharger - Audio & Musique
Vob merge - Télécharger - Montage & Édition
Vba autofill ✓ - Forum Excel

5 réponses

Résumé de la discussion

La demande porte sur une macro VBA Excel qui, à partir de A135 sur la feuille ORI2, doit fusionner A135:A159 si le texte fait moins de 1400 caractères et A135:A187 si ce texte dépasse 1400. Des intervenants présentent des corrections potentielles liées à la syntaxe des conditions If et Len, insistant sur le fait qu'il faut tester Len(Cells(i,1).Value) et structurer proprement les ElseIf. Plusieurs échanges proposent des essais avec des exemples concrets et des modifications de code, et demandent un exemple reproductible pour clarifier la solution et éviter les ambiguïtés dans l'implémentation.

Réponse 1 / 5
f894009 Messages postés 17417 Date d'inscription Statut Membre Dernière intervention 1 717

Re bonjour,

ori(peaux), ori(flamme) y a peut-etre de quoi se perdre.

Mais revenons a votre soucis. Une maquette representative de la realite et ce que vous voulez au final
svp
1
1. Styla27 Messages postés 44 Date d'inscription Statut Membre Dernière intervention 1
  
  Ah ! Je commençais à paniquer...
  Merci d'avance et beaucoup en tout cas, voici le fichier :
  
  J'ai utilisé les mêmes cellules
  https://www.cjoint.com/c/FBynr3S7XbG
  
  Feuille ORI2 cellule 135 :)
  
  Je répète ce que j'avais écrit dans l'autre post au cas où :
  
  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
  
  0
2. f894009 Messages postés 17417 Date d'inscription Statut Membre Dernière intervention 1 717 > Styla27 Messages postés 44 Date d'inscription Statut Membre Dernière intervention
  
  Re,
  
  Vous parlez de la cellule A135, mais dans votre code
  sub maxi()
  vous partez de A135 jusqu'a la derniere non vide avec insertion de ligne(s) pour le decoupage de A135 et les autres. Est-ce bien comme cela qu'il faut programmer ??
  
  0
3. Styla27 Messages postés 44 Date d'inscription Statut Membre Dernière intervention 1 > f894009 Messages postés 17417 Date d'inscription Statut Membre Dernière intervention
  
  :/ je suis partie d'un code que j'ai trouvé sur un sujet différent et j'ai découvert le VBA fin de semaine dernière.
  
  En fait, je veux juste que le texte qui sera trop long de la cellule A135 :
  sera découpé à chaque fois qu'il trouve mot ORIXXX jusqu'à la fin.
  
  En gros je voudrais ça sur ma feuille :
  Cell A135 = ORI1 : blablabla
  Cell A136 = ORI5 : blabla
  Cell A137 = ORI15 : blabla
  ...
  Cell AXXX = ORI367 : blabla
  
  puisse se prolonger dans les cellules d'en bas à chaque fois, jusqu'à la fin de mon texte.
  (redimension de cellule si nécessaire donc facultatif)
  
  Je ne sais pas si j'ai été claire :/
  Merci
  
  PS : si vous avez une meilleure solution, je suis preneuse mais je pense que si on trouve ce code, ce sera parfait :D
  
  0
4. f894009 Messages postés 17417 Date d'inscription Statut Membre Dernière intervention 1 717 > Styla27 Messages postés 44 Date d'inscription Statut Membre Dernière intervention
  
  Re,
  
  Normal cette partie:
  
  ORI4 : Simplement limité 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.
  
  Comment savoir si Twitter ou SMS ?
  
  0
5. Styla27 Messages postés 44 Date d'inscription Statut Membre Dernière intervention 1
  
  Ah haha, c'est comme du llorem ipsum. J'ai mis du texte en attendant...
  
  ORI4 : blablabla (oubli de saut de ligne) ORI2 : blabla
  
  0
Réponse 2 / 5
gbinforme Messages postés 14930 Date d'inscription Statut Contributeur Dernière intervention 4 744

Bonjour,

Je suis une newbie. J'essaye le VBA Excel.

Commencer par faire une fusion c'est on ne peux plus risqué car la gestion des fusions de cellules n'est pas une sinécure !
Si tu essayais autre chose ce serait plus raisonnable.
0
1. Styla27 Messages postés 44 Date d'inscription Statut Membre Dernière intervention 1
  
  Bonjour,
  Gbinforme, merci pour le conseil, mais la seule cellule pleine est la 135, les autres sont vides. Donc pas de risque.
  
  Mais c'est histoire de mettre beaucoup de texte dans une cellule (grâce à la fusion) sans changer la hauteur des lignes ou insérer de nouvelles lignes car ma mise en page ne doit pas bouger sur les pages d'en bas. Donc j'en ai vraiment besoin. Sinon, je n'appellerai pas de l'aide !
  
  Mais si vous avez autres choses à me conseiller qui pourraient me faire avancer, je vous lis. :)
  
  0

Gyrus Messages postés 3360 Statut Membre 526

Bonjour Styla27,
Salutations gbinforme,

Un exemple :

Sub Fusionner()
Dim i, Fin, Fin2 As Integer
    i = 135
    With Sheets("ORI2")
        .Range("A" & i).Select
        Selection.UnMerge
        If .Cells(i, 1).Value <> "" Then
            If Len(.Cells(i, 1)) < 1400 Then
                Fin = 159
            Else
                Fin = 187
            End If
            'Formate et fusionne
            With .Range(.Cells(i, 1), .Cells(Fin, 1))
                .HorizontalAlignment = xlGeneral
                .VerticalAlignment = xlTop
                .WrapText = True
                .Orientation = 0
                .AddIndent = False
                .ShrinkToFit = False
                .MergeCells = True
                .Merge
            End With
        End If
    End With
End Sub

A+

Styla27 Messages postés 44 Date d'inscription Statut Membre Dernière intervention 1

Bonjour Gyrus,
Merci de votre aide !

Mais avec le code que vous m'aviez donné, il me met erreur 1004, erreur définie par l'application ou l'objet. :/
0

Réponse 4 / 5
michel_m Messages postés 18903 Date d'inscription Statut Contributeur Dernière intervention 3 320
Bonjour Styla27,Gbinforme,Gyrus....

Comme Gbinforme l'a fait remarquer:
la gestion des fusions de cellules n'est pas une sinécure !

tu as la possibilité de "centrer sur plusieurs colonnes" (ruban accueil-alignement)
donc
```
Sub ccm()
With Sheets("OR12")
    Select Case Len(Range("A135"))
            Case Is = 0
                    Exit Sub
            Case Is > 1400
                Range("A135:A159").HorizontalAlignment = xlCenterAcrossSelection
            Case Else
                Range("A135:A187").HorizontalAlignment = xlCenterAcrossSelection
    End Select
End With
End Sub
```
0
1. Styla27 Messages postés 44 Date d'inscription Statut Membre Dernière intervention 1
  
  Bonjour Michel_m et merci aussi de votre aide
  
  mais je n'ai pas compris votre réponse par rapport à ma question. J'ai donc essayé de copier le code et ça me met, erreur d'exécution 9. L'indice n'appartient pas à la sélection ! :/
  
  0
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
Réponse 5 / 5
michel_m Messages postés 18903 Date d'inscription Statut Contributeur Dernière intervention 3 320
Bonjour
pour comprendre,essaies avec l'enregistreur de macros

sélectionner les cellules
alignement
centrer sur plusieurs colonnes

et j'ai l'impression que tu nr donnes pas peut-être la disposition réelle de ton classeur...
```
Mettre le classeur sans données confidentielles en pièce jointe sur https://www.cjoint.com/
et coller le raccourci  par un clic droit sur le lien proposé dans le message de réponse 
```
Dans l’attente
0
1. Styla27 Messages postés 44 Date d'inscription Statut Membre Dernière intervention 1
  
  Ah ! Haha je viens de comprendre !
  Et aussi de comprendre pourquoi le code ne fonctionnait pas, je n'ai pas vérifié au bon endroit. La feuille s'appelle O R I 2 et non O R 1 2 ;) J'étais sûrement fatiguée !
  
  mais ce n'est pas du tout ce que je recherche. Je ne veux pas que les pages soient actives :
  J'ai une macro pour faire apparaître un texte
  seulement si condition.
  
  Si les conditions ne sont pas remplies,
  ce texte n'apparaît pas en A135.
  Si oui, il apparaît en A135
  avec fusion des cellules (macro demandée).
  
  Pourquoi ? Parce que le texte est long pour une cellule et que les personnes qui vont se servir de ce fichier ne sont pas des "Exceleurs" !
  
  Et surtout parce que j'ai une macro pour un enregistrement automatique et que je ne veux pas que les pages blanches soient enregistrées dans ce PDF.
  
  Mais je suis en train de voir pour une autre solution car je n'ai toujours pas de réponse jusqu'à maintenant
  
  Cette solution que je n'ai pas encore trouvé :
  Si texte plus long que X caractères, continuer à copier la suite dans la cellule du bas, ainsi de suite. D'ailleurs, si vous avez une solution svp ! :)
  
  PS : je ne peux pas envoyer mon fichier, trop confidentiel. :/
  
  0
2. Styla27 Messages postés 44 Date d'inscription Statut Membre Dernière intervention 1
  
  J'ai trouvé ce code ci qui marche bien et que j'ai modifié en fonction de mes besoins.
  
  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 =5 incremente la ligne de destination
  Next y
  SuiteL = SuiteL + 1
  MaLigne = MaLigne + 1
  Loop
  End Sub
  
  Par contre, mon texte se présente par exemple comme ça :
  "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 : La limite de caractères pour Twitter est 140. Un message texto SMS peut avoir jusqu'à 160 caractères.
  
  ORI9 : 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.
  
  ORI13 : La limite de caractères pour Twitter est 140. Un message texto SMS peut avoir jusqu'à 160 caractères.
  
  ORI15 : 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."
  
  Et ce code me coupe le texte à 160 caractères, ce qui fait que ce n'est pas du tout esthétique.
  
  Pourriez-vous m'aider svp ?
  
  0

VBA Fusionner cellules avec plusieurs conditions et instructions

5 réponses

Discussions similaires

Newsletters