VBA pour mise en forme

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

  • mise_en_forme.xlsx
    48.5 KB · Affichages: 59
Trier par date Trier par votes
Robert

Robert

XLDnaute Barbatruc
Repose en paix
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
N

natacha

XLDnaute Occasionnel
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
hellnar

hellnar

XLDnaute Junior
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

  • mise_en_forme par Hellnar.xlsm
    57.3 KB · Affichages: 54
Vote positif 0 Vote négatif
Robert

Robert

XLDnaute Barbatruc
Repose en paix
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
hellnar

hellnar

XLDnaute Junior
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
Staple1600

Staple1600

XLDnaute Barbatruc
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
hellnar

hellnar

XLDnaute Junior
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

Discussions similaires

jeanmi
  • Question
XL 2010 mise en forme conditionnelle
Réponses
2
Affichages
296
jeanmi
jeanmi
C
  • Question
XL 2021 VBA pour comparer des données
Réponses
7
Affichages
306
Cristobal
C
S
  • Résolu(e)
XL 2019 VBA Mise en forme conditionnelle
Réponses
2
Affichages
361
sum01
S
A
  • Résolu(e)
XL 2016 Mise en forme conditionnel
Réponses
6
Affichages
265
mapomme
mapomme
R
  • Question
XL 2019 Mise en forme conditionnelle
Réponses
4
Affichages
255
Nain porte quoi
N
L
  • Résolu(e)
XL 2016 mise en forme conditionnelle
Réponses
2
Affichages
291
litchoutsou
L
L
  • Résolu(e)
XL 2021 Mise en forme conditionnelle avec barre de données
Réponses
4
Affichages
254
Liowat
L
P
  • Question
XL 2019 Mise en forme conditionnelle sur plusieurs feuilles
Réponses
6
Affichages
354
JHA
J
A
  • Résolu(e)
XL 2010 date figee et mise en forme conditionnelle
Réponses
3
Affichages
242
Atlas85200
A
@
  • Résolu(e)
Microsoft 365 mise en forme conditionnelle
Réponses
12
Affichages
265
@lea
@

Membres actuellement en ligne

14 membres et 107 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 502
Messages
2 089 022
Membres
104 006
dernier inscrit
CABROL