VBA pour mise en forme

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion natacha
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
N

natacha

XLDnaute Occasionnel
Bonjour à tous,
j'ai un petit souci j'ai un fichier avec des données dans une seule colonne, et je souhaiterais dispatcher les données dans plusieurs colonnes. Mais la syntaxe est assez complexe et la fonction "convertir" d'excel ne convient pas. J'imagine qu'il faut faire du VBA, mais je ne sais pas faire.
Je vous remercie par avance.
Je vous transmets mon fichier pour vous rendre compte.
Natacha
 

Pièces jointes

Trier par date Trier par votes
Re : VBA pour mise en forme

Bonjour Natacha, bonjour le forum,

Je te propose le code ci-dessous (à tester) :
Code: 
Sub Macro1()
Dim pl As Range 'déclare la variable pl (PLage)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim dl As Long 'déclare la variable dl (Dernière Ligne)
Dim x As Long 'déclare la variable x (incrément de ligne)
 
Application.ScreenUpdating = False 'masque les changement à l'écran
With Sheets("depart") 'prend en compte l'onglet "depart" (à adapter...)
    'définit la plage pl (cellules éditées de la colonne A (en partant de la ligne 3) de l'onglet "depart"
    Set pl = .Range("A3:A" & .Cells(Application.Rows.Count, 1).End(xlUp).Row)
    For Each cel In pl 'boucle 1 : sur toutes les cellules cel de la plage pl
        If Left(cel.Value, 1) <> "-" Then 'condition : si le premier caractère de la cellule n'est pas "-"
            cel.Cut cel.Offset(0, 3) 'coupe la cellulle et la colle dans la colonne D
        Else 'sinon
            cel.Offset(1, 0).Cut cel.Offset(0, 3) 'coupe la cellule en dessous et la colle dans la colonne D de cel
            cel.Value = Replace(cel.Value, "-", "") 'supprime les "-"
            cel.Offset(0, 2).Value = Split(cel.Value, ")", -1)(1) 'récupère la partie après ")" en colonne C
            cel.Offset(0, 1).Value = "(" & Split(cel.Value, "(", -1)(1) 'récupère la partie après "(" en colonne B
            cel.Offset(0, 1).Value = Split(cel.Offset(0, 1).Value, ")", -1)(0) & ")" 'récupère la partie avant ")" en colonne B
            cel.Value = Split(cel.Value, "(", -1)(0) 'recupère la partie avant "(" en colonne A
        End If 'fin de la condition
    Next cel 'prochaine cellule de la boucle 1
    dl = pl.SpecialCells(xlCellTypeLastCell).Row 'définit la dernière ligne de la plage pl
    For x = dl To 3 Step -1 'boucle 2 : sur toutes les lignes de la plage (en partant de la dernière jusqu'à la troisième)
        'si la cellule de la colonne D de la ligne est vide, supprime la ligne
        If .Cells(x, 4).Value = "" Then Rows(x).Delete shift:=xlShiftUp
    Next x 'prochaine ligne de la boucle 2
End With 'fin de la prise en compte de l'onglet "depart"
Application.ScreenUpdating = True 'affiche les changement à l'écran
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
Re : VBA pour mise en forme

Merci beaucoup robert,
ça fonctionne bien, mais est il possible pour la dernière colonne de mettre le tout dans une même cellule?
En gros que pour chacune de mes variables j'ai une ligne?
Merci d'avance.
natacha
 
Vote positif 0 Vote négatif
Re : VBA pour mise en forme

Bonjour,

Je propose la macro suivante qui fait correctement le travail pour autant que je puisse m'en rendre compte
Option Base 1
Sub ufr1()
ActiveWorkbook.Save
Sheets("depart").Select
Sheets("depart").Copy Before:=Sheets(1)

Dim colonne(4)
xx = "----------" ' texte initial à retirer
longueur = Len(xx)
Columns("A:A").SpecialCells(xlCellTypeConstants, 23).Select ' selection les cellules non vides
For Each cellule In Selection
cc = cellule.Formula
If cc Like xx & "*" Then ' nouvelle donnée
nouveau = nouveau + 1

For i = 1 To 4
Cells(nouveau, i + 1) = colonne(i)
colonne(i) = ""
Next

cc = Right(cc, Len(cc) - longueur)
gauche = Application.Find("(", cc)
droite = Application.Find(")", cc)
colonne(1) = Left(cc, gauche - 1)
colonne(2) = Mid(cc, gauche, droite - gauche + 1)
colonne(3) = "auto"
Else
colonne(4) = colonne(4) & Chr(13) & cc
End If
cellule.Clear
Next
Range("A1").Select
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft

MsgBox "Travail terminé"
End Sub

Remarques :
Il faut bien mettre en haut le Option Base 1 pour que les tableaux commencent à 1
Ensuite j'oblige une sauvegarde pour plus de sécurité
Je crée une nouvelle feuille sur laquelle travailler pour vérification.
La suite se comprend ...

Enfin il faut que le format de fichier accepte les macros ce qui n'est pas le cas de xlsx.
 

Pièces jointes

Vote positif 0 Vote négatif
Re : VBA pour mise en forme

Bonjour Natacha, bonjour le forum,

Essaie comme ça :
Sub Macro1()
Dim pl As Range 'déclare la variable pl (PLage)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim npl As Range 'déclare la variable npl (Nouvelle PLage)
Dim cel1 As Range 'déclare la variable cel1 (CELlule 1)
Dim dl As Long 'déclare la variable dl (Dernière Ligne)
Dim x As Long 'déclare la variable x (incrément de ligne)

Application.ScreenUpdating = False 'masque les changement à l'écran
With Sheets("depart (2)") 'prend en compte l'onglet "depart" (à adapter...)
'définit la plage pl (cellules éditées de la colonne A (en partant de la ligne 3) de l'onglet "depart"
Set pl = .Range("A3:A" & .Cells(Application.Rows.Count, 1).End(xlUp).Row)
For Each cel In pl 'boucle 1 : sur toutes les cellules cel de la plage pl
If Left(cel.Value, 1) <> "-" Then 'condition : si le premier caractère de la cellule n'est pas "-"
If cel.Value <> "" Then cel.Cut cel.Offset(0, 3) 'coupe la cellulle et la colle dans la colonne D
Else 'sinon
cel.Offset(1, 0).Cut cel.Offset(0, 3) 'coupe la cellule en dessous et la colle dans la colonne D de cel
cel.Value = Replace(cel.Value, "-", "") 'supprime les "-"
cel.Offset(0, 2).Value = Split(cel.Value, ")", -1)(1) 'récupère la partie après ")" en colonne C
cel.Offset(0, 1).Value = "(" & Split(cel.Value, "(", -1)(1) 'récupère la partie après "(" en colonne B
cel.Offset(0, 1).Value = Split(cel.Offset(0, 1).Value, ")", -1)(0) & ")" 'récupère la partie avant ")" en colonne B
cel.Value = Split(cel.Value, "(", -1)(0) 'recupère la partie avant "(" en colonne A
End If 'fin de la condition
Next cel 'prochaine cellule de la boucle 1
dl = .Cells(Application.Rows.Count, 4).End(xlUp).Row 'définit la dernière ligne
For x = dl To 3 Step -1 'boucle 2 : sur toutes les lignes de la plage (en partant de la dernière jusqu'à la troisième)
If Cells(x, 4).Value = "" Then Rows(x).Delete shift:=xlShiftUp 'suuprime les ligne où la colonne D est vide
Next x
'redéfinit la plage pl (cellules éditées de la colonne A (en partant de la ligne 3) de l'onglet "depart"
Set pl = .Range("A3:A" & .Cells(Application.Rows.Count, 1).End(xlUp).Row)
For Each cel In pl 'boucle 2 : sur toutes les cellules cel de la plage pl
If cel.Offset(1, 0) = "" And cel.Offset(0, 3).Value <> "" Then 'condition 1 : si la cellule en dessous est vide et la cellule en colonne D n'est pas vide
Set npl = Range(cel.Offset(0, 3), cel.End(xlDown).Offset(-1, 3)) 'définit la nouvelle plage
For Each cel1 In npl.Offset(1, 0).Resize(npl.Rows.Count - 1) 'boucle 3 sur toutes les cellule cel1 de la nouvelle plage (sauf la première cellule de la plage)
If cel1.Value <> "" Then 'condition 2 : si la celllule cel1 n'est pas vide
npl.Cells(1).Value = npl.Cells(1).Value & " " & cel1.Value 'concatene le texte de la première cellule de la nouvelle plage avec le texte de cel1
cel1.Value = "" 'supprime le texte de cel1
End If 'fin de la condition 2
Next cel1 'prochaine cellule cel1 de la boucle 3
End If 'fin de la condition 1
Next cel 'prochaine cellule cel de la boucle 2

dl = .Cells(Application.Rows.Count, 4).End(xlUp).Row 'redéfinit la dernière ligne
For x = dl To 3 Step -1 'boucle 4 : sur toutes les lignes de la plage (en partant de la dernière jusqu'à la troisième)
'si la cellule de la colonne A de la ligne est vide, supprime la ligne
If .Cells(x, 1).Value = "" Then Rows(x).Delete shift:=xlShiftUp
Next x 'prochaine ligne de la boucle 4
End With 'fin de la prise en compte de l'onglet "depart"
Application.ScreenUpdating = True 'affiche les changement à l'écran
End Sub

[Édition]
Ooops bonjour Heelnar j'avais pas rafraîchi. P... voilà du code optimisé j'y jette une œil voire même les deux...
 
Dernière édition:
Vote positif 0 Vote négatif
Re : VBA pour mise en forme

Merci Robert,

Ton programme n'était pas mal et super bien renseigné, ce qui est intéressant pour le lecteur.
Par contre, j'ai remarqué que tu n'utilises pas souvent les fonctions propres à Excel avec Application. comme deux dans cet exemple (Application.Find ou SpecialCells..) c'est très pratique et très efficace.
Par contre on reconnait les vieux loups de mer qui suppriment les cellules en partant du bas et non du haut comme on peut le faire manuellement sur Excel. L'humain ne travaille pas comme la machine.

Cordialement

Hellnar
 
Vote positif 0 Vote négatif
Re : VBA pour mise en forme

Bonsoir


hellnar: cela fatigue moins les yeux ainsi 😉
(je me suis permis la suppression de quelques Select)
Code: 
Option Base 1
Sub ufr1()
    ActiveWorkbook.Save
    Sheets("depart").Copy Before:=Sheets(1)
Dim colonne(4)
        xx = "----------" ' texte initial à retirer
    longueur = Len(xx)
    Columns("A:A").SpecialCells(xlCellTypeConstants, 23).Select ' selection les cellules non vides
    For Each cellule In Selection
    cc = cellule.Formula
    If cc Like xx & "*" Then ' nouvelle donnée
  nouveau = nouveau + 1

        For i = 1 To 4
            Cells(nouveau, i + 1) = colonne(i)
            colonne(i) = ""
        Next

        cc = Right(cc, Len(cc) - longueur)
        gauche = Application.Find("(", cc)
        droite = Application.Find(")", cc)
        colonne(1) = Left(cc, gauche - 1)
        colonne(2) = Mid(cc, gauche, droite - gauche + 1)
        colonne(3) = "auto"
    Else
        colonne(4) = colonne(4) & Chr(13) & cc
    End If
cellule.Clear
    Next
Columns("A:A").Delete Shift:=xlToLeft
MsgBox "Travail terminé"
End Sub
 
Vote positif 0 Vote négatif
Re : VBA pour mise en forme

@ staple1600

Bien sûr, entièrement d'accord, c'est ainsi que le programme est écrit sur ma machine, mais les copier/coller retirent ces tabulations de mise en forme (un effet d'Apple ??) et, honte sur moi, j'ai la flemme de les remettre sur le fil puisqu'ils sont dans le fichier joint.

Cordialement

Hellnar
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

C
  • Question Question
XL 2016 récupérer la mise en forme d'une cellule vers une autre cellule
Réponses
1
Affichages
649
TooFatBoy
TooFatBoy
E
  • Question Question
XL 2016 Mise en forme conditionnelle conservée après actualisation d'un TCD
Réponses
1
Affichages
332
chris
chris
C
  • Résolu(e)
XL 2021 Mise en forme MsgBox
2 3
Réponses
43
Affichages
1 K
Constantin
C
L
  • Question Question
XL 2021 Mise en forme conditionnelle à partir d'autre colonne
Réponses
7
Affichages
368
CHRIS1945
C
L
  • Question Question
XL 2021 RechercheX et Mise en forme conditionnelle
2
Réponses
17
Affichages
414
Lucie85
L
gh4
  • Question Question
Autres impossible de convertir nombre texte en nombre
Réponses
8
Affichages
421
dysorthographie
dysorthographie
Tony44
  • Question Question
XL 2016 Transformer la mise en forme d'un tableau
2
Réponses
22
Affichages
815
Cousinhub
Cousinhub
D
  • Résolu(e)
XL 2019 Report valeur et mise en couleur
Réponses
9
Affichages
230
DST
D
A
  • Question Question
XL 2019 Mise en forme
Réponses
4
Affichages
318
TooFatBoy
TooFatBoy
C
  • Résolu(e)
XL 2021 Mise en page pour imprimer un fichier trié et filtré
Réponses
3
Affichages
134
sylvanu
sylvanu
A
  • Question Question
XL 2016 Mise en forme conditionnelle et valeur égale à 0...
Réponses
5
Affichages
470
sylvanu
sylvanu
T
  • Résolu(e)
XL 2010 Mise en forme conditionnelle
Réponses
4
Affichages
462
tchi456
T
jeanmi
  • Résolu(e)
XL 2010 Mise en forme d’un graphique spécifique
Réponses
6
Affichages
270
jeanmi
jeanmi
F
  • Question Question
XL 2016 Mise en forme conditionnelle d'une forme (cartographie)
Réponses
9
Affichages
584
francois95
F
J
  • Question Question
XL 2013 mise en forme conditionnelle contenant plusieurs mots
2
Réponses
16
Affichages
901
jo657
J
N
  • Résolu(e)
Microsoft 365 Copier une image d'une feuille de calcul vers un UserForm
Réponses
4
Affichages
199
NONO14
N
P
  • Résolu(e)
Microsoft 365 VBA - Survol d'un Label déclenchement action
Réponses
8
Affichages
339
patricko-13
P
J
  • Question Question
XL 2016 classeur rendez-vous avec userform en VBA
Réponses
4
Affichages
179
J- Paul
J
N
  • Question Question
Microsoft 365 Calcul de prix moyen pondéré de recettes
2
Réponses
15
Affichages
851
Nino63
N
H
  • Question Question
XL 2019 masquer des colonne sous condition d'une cellule en vba
Réponses
5
Affichages
260
sylvanu
sylvanu
Retour