Création boucle

Version imprimable

29/12/2016, 11h10
bbiss

Création boucle

Bonjour à tous,

Je me retrouve avec un fichier Excel avec les caractéristiques suivantes:
Colonne A
2 lignes 2 et 3 comportant des données tel que nom-prénom
Colonne B C D comportant d'autres données mais sur une lignes donc ok
J'enregistre la macro suivante:
Insérer une colonne
Copier le la donnée de la deuxième ligne de la colonne A vers la colonne B
J'efface le contenu de la deuxième ligne de la colonne A
Je fusionne successivement les deux cellules des deux lignes pour les deux colonnes

Le problème c'est que j'ai fais ca sur 1100 lignes et le programme est trop long à s'exécuter,
Pouvez-vous m'aider pour mettre en place une boucle svp ?

Merci d'avance
29/12/2016, 11h14
Jean-Philippe André

Salut,

dans l'ideal, tu nous fournis au moins le code VBA qui t'a ete genere par l'enregistreur de macros, non ?

J'ai laisse ma boule de cristal dans mon ancienne redingote ;)

Salut,

le code est le suivant:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
Sub Macro1()
'
' Macro1 Macro
'
 
'
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Prénom"
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Nom"
    Range("A3").Select
    Selection.Copy
    Range("B2").Select
    ActiveSheet.Paste
    Range("A3").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("B2:B3").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("A2:A3").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("A5").Select
    Selection.Copy
    Range("B4").Select
    ActiveSheet.Paste
    Range("A5").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("B4:B5").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("A4:A5").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
End Sub

29/12/2016, 13h07
unparia

A Jean-Philippe André ( à qui je mets un :plusser:)

Citation:

J'ai laisse ma boule de cristal dans mon ancienne redingote

Et moi, mes verres correcteurs anti-vertige pour lire un code non indenté et travaillant à grands renforts de select, selection, etc (sources de lenteurs) ... et non directement sur les objets Excel. ;)

On peut deja simplifier le tout avec ceci :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
Sub Macro1()
'
' Macro1 Macro
'
 
'
    Columns("B:B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("B1").FormulaR1C1 = "Prénom"
    Range("A1").FormulaR1C1 = "Nom"
    Range("A3").Copy Destination:=Range("B2")
 
    Range("B2").ClearContents
 
    With     Range("B2:B3")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        .Merge
    End With
 
    With     Range("A2:A3")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        .Merge
    End With
    Range("A5").Copy Destination:=    Range("B4")
    ActiveSheet.Paste
    Range("B4").ClearContents
 
    With     Range("B4:B5")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        .Merge
    End With
 
 
    With Range("A4:A5")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        .Merge
    End With
 
End Sub

29/12/2016, 14h07
RyuAutodidacte

Bonjour bbiss (l'étudiant),

Bienvenue !
Conseils :
- il est important en 1er lieu de lire les règles du Forum (il y a même une partie concernant les étudiants ;) )
- une autre règle importante mais pas besoin de te la dire, @Jean-Philippe André te la signalé en post #2
- lorsque l'on post un code : :tagcode: , ça sera plus lisible pour tout le monde (utiliser le bouton d'enrichissement #), comme indiqué par @unparia au post #4 sur la lisibilité (sans compter l'indentation)

et enfin, on trouve souvent une Faq, qui plus est, amplement visible sur la page du site, et en cherchant bien, concernant les boucles : La gestion des boucles dans Excel

Edit : petite modif
29/12/2016, 16h05
bbiss

Merci pour ton retour, le but c'est de pouvoir le faire sur 1500 lignes par exemple

Re,
de rien

Citation:

le but c'est de pouvoir le faire sur 1500 lignes par exemple

le but de ce forum par exemple et de t'aider à faire ton code lorsque tu buttes sur celui-ci ou un problème relatant une erreur, mais pas de faire le travail à ta place.
concernant les boucles j'ai déjà donné le lien pour l'apprentissage de celles-ci

là je te donne un exemple vite fais (bâclé) avec un nom en A2 et prénom en A3
je te laisse le soin d'utiliser la touche F1 pour l'aide en vba et la touche F8 permettant de faire du pas à pas dans le code - la fenêtre des variables locales est importante pour comprendre ce qui se passe dans le code, donc l'affiché
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 Sub Deplace() With Sheets("Feuil1").Range("A3") .Offset(-1, 1).Value = .Value With .Offset(-1, 1).Resize(2) .Merge .VerticalAlignment = xlCenter .ReadingOrder = xlContext .IndentLevel = 0 End With .Clear With .Offset(-1, 0).Resize(2) .Merge .VerticalAlignment = xlCenter .ReadingOrder = xlContext .IndentLevel = 0 End With End With End Sub
à toi de trouver l'astuce pour insérer le code dans une boucle adéquat (indice : départ de la boucle et Step)
n'oublie pas le code manquant non mis sur le mien