Discussion :

[Ghost0000]

Bonjour à tous,

Je viens de créer un rapport Excel avec une macro, je suis débutant en VBA, et j'aimerai quelques conseils d'experts

Le souci dans mon code est le suivant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
'Saut de ligne entre chaque opération
        Dim c As Range
        For Each c In Range("A2", Range("A65536").End(xlUp))
            If c.Offset(-2, 0) <> c.Offset(-1, 0) Then c.Offset(-2, 0).EntireRow.Insert
        Next c

Explications: Pour chaque ligne au sein de la sélection A2:A65536, j'aimerai que la macro détecte le moment où il y a un changement de numéro (exemple : on passe de 60 000 à 60 002), et précisément à ce moment là, j'aimerai rajouter une ligne vide au sein du classeur afin que visuellement, on puisse différencier les éléments par rapport à la colonne A:A.

Ma liste commence à la colonne A2.

Cause du problème : Lors de l'ajout de la ligne vierge, mon code compare le numéro actuelle (60 002)avec la ligne vierge (""), du coup, il rajoute sans cesse de nouvelle ligne et j'ai l'impression qu'il n'est pas possible de l'arrêter...

Je sais que le souci proviens d'ici :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If c.Offset(-2, 0) <> c.Offset(-1, 0) Then c.Offset(-2, 0).EntireRow.Insert

mais je ne sais pas quelle syntaxe adopter...

Vous remerciant par avance de votre aide.

Cordialement.

GK

[clementmarcotte]

Bonjour,

Je n'ai pas testé, mais j'essaierais deux if imbriqués dans ce genre-là:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
For Each c In Range("A2", Range("A65536").End(xlUp))
     if c.offset(-1,0) <>"" then
            If c.Offset(-2, 0) <> c.Offset(-1, 0) Then c.Offset(-2, 0).EntireRow.Insert
     end if
next c

Ceci dit, tu ferais bien de tester au pas à pas en espionnant tes valeurs, parce que je ne suis vraiment pas sûr de mes "Offset"; cela fait trop longtemps. l'idée de base est de vérifier si ta cellule n'est pas vide avant d'ajouter une ligne.

Ou bien en plus "fancy", comme on dit par chez-nous:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
 
dim LigneInsérée as boolean
For Each c In Range("A2", Range("A65536").End(xlUp))
     if ligneInsérée = false then
           If c.Offset(-2, 0) <> c.Offset(-1, 0) Then 
                 c.Offset(-2, 0).EntireRow.Insert
                 LigneInsérée = true
           else
                 LigneInsérée = false
           end if
     end if
next

[Quentin77170]

Salut à toi,

En général dans ce genre de situation, la macro s'emballe car tu ajoutes une ligne, quand il passe à la "ligne suivante", il retombe sur celle qui était précédemment là et que tu as du coup décalée vers le bas ! Donc il rajoute encore une ligne, etc.

Fais plutôt comme ça, en passant par une boucle sur la ligne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Sub test()
'Saut de ligne entre chaque opération
        Dim ligne As Integer
        For ligne = 2 To Range("A65536").End(xlUp).Row
            If Cells(ligne - 1, "A") <> Cells(ligne, "A") Then Rows(ligne).Insert: ligne = ligne + 1
        Next ligne
End Sub

Le souci avec le for each, c'est que tu ne peux pas décaler le prochain "c" de ta boucle (ou du moins je ne sais pas le faire)... il passe automatiquement sur celui que tu ne veux pas (tu pourrais tester si la ligne est vide et du coup ne rien faire pour que ça passe bien à la suivante, mais avec les lignes comme je propose ça marche très bien !).

En espérant que ça t'aide !

[Ghost0000]

Bonjour à vous deux !

Je vous remercie pour l'aide que vous m'avez fourni, c'est exactement ce que je cherchai !

@Clément : En effet, il y a une erreur sur les offsets, pas de souci ! C'est de ma faute ....
@Quentin : Ton code est fonctionnel, j'ai juste copier-coller et, ça a marcher !

Autre chose désormais : mon code est trop ...Volumineux ... : 66 583 Ko --> 66 Mo (je pense donc, que je réalise des opérations inutiles, mais je ne sais pas réellement ce qui donne du poids à mon rapport Excel Vba :

Voici mon code complet :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
Sub Extraction()
'Suppression du déroulement de la macro à l'écran
Application.ScreenUpdating = False
 
'Définitions des variables
Dim wk As Workbook
Dim Fichier As String
Dim Nom As String
 
'Suppresion des alertes
Application.DisplayAlerts = False
 
'Visibilité de la base Brute activé
Sheets("Base Brute").Visible = True
 
'Suppression des anciennes données
ThisWorkbook.Sheets(2).Cells.ClearContents
 
'Ouverture d'un document par l'utilisateur
Fichier = Application.GetOpenFilename(, , "Selection dsu fichier excel", "", "")
 
'En cas d'annulation de la fenêtre d'importation
If Fichier <> "Faux" Then
Workbooks.Open (Fichier)
End If
 
If Fichier = "Faux" Then
'Sélection de la base Brut puis activation du mode caché
Sheets("Base Brute").Select
    ActiveWindow.SelectedSheets.Visible = False
Sheets("Contrôle").Select
End
End If
 
'Activation du Fichier
Nom = ActiveWorkbook.Name
Windows(Nom).Activate
 
'Copie du contenu du document en direction du rapport
For i = 1 To 99
Workbooks(Nom).Sheets(1).Columns(i).Copy ThisWorkbook.Sheets(2).Columns(i)
Next i
 
'Fermeture du document
Workbooks(Nom).Close
 
'Sélection de la base Brut puis activation du mode caché
Sheets("Base Brute").Select
    Application.CutCopyMode = False
    Rows("1:100").Select
    Selection.Copy
Sheets("Donnees").Select
    Cells.Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("A1").Select
Sheets("Base Brute").Select
    Selection.Copy
Sheets("Donnees").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Application.CutCopyMode = False
    Range("A1").Select
 
    'Définition des dimensions
    Dim var1 As Integer 'nb ligne
 
    'Suppression de la 2ème ligne
    Rows("2:2").Select
    Rows("2:2").Delete
 
    'Définition de la cellule de calcul temporaire
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "=COUNTA(C[1])+1"
    Range("A1").Select
    Selection.Copy
    Range("B1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
 
    'Suppression de la dernière ligne
    var1 = Range("B1").Value
    Rows(var1 & ":" & var1).Select
    Rows(var1 & ":" & var1).Delete
    Range("A1:B1").ClearContents
 
    'Mise en forme
    Range("A2").Select
    Selection.ClearContents
    Columns("A:A").Select
    Selection.Delete shift:=xlToLeft
    Columns("B:B").Select
    Selection.Insert shift:=xlToRight
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="-", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
        TrailingMinusNumbers:=True
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Coulée"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Opération"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Echantillon"
    Range("A1").Select
 
    'Saut de ligne entre chaque opération
        Dim ligne As Integer
        For ligne = 2 To Range("A65536").End(xlUp).Row
            If Cells(ligne - 1, "A") <> Cells(ligne, "A") Then Rows(ligne).Insert: ligne = ligne + 1
        Next ligne
 
    'On cache la base brute
    Sheets("Base Brute").Select
    ActiveWindow.SelectedSheets.Visible = False
 
'Selection du rapport Importé
Sheets("Donnees").Select
 
'Message de réussite de l'import
MsgBox "Import réussi !"
 
'Suppression du déroulement de la macro à l'écran
Application.ScreenUpdating = True
End Sub

[clementmarcotte]

Bonjour,

Ce qui me semble le plus flagrant au premier regard, c'est qu'on peut facilement éviter de nombreux select et activate. Par exemple, tu peux remplacer cela (et les autres similaires):

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Sheets("Base Brute").Select
    Application.CutCopyMode = False
    Rows("1:100").Select
    Selection.Copy

Par cela:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Application.CutCopyMode = False
Sheets("Base Brute").rows(("1:100").copy

Cela aiderait aussi à gagner en rapidité.

Aussi, il me semble qu'il n'est pas nécessaire de sélectionner les cellules avant de les supprimer.

Cela peut aussi arriver qu'à force de modifier le code VBA, le classeur devienne obèse. Tu peux essayer VBA Code Cleaner de Rob Bovey. (C'est un des grands experts d'Excel)

http://www.appspro.com/Utilities/CodeCleaner.htm

[Ghost0000]

Bonsoir Clément,

Merci de ton aide, je vais pouvoir revoir mon code afin de l'améliorer.

Concernant le logiciel de Rob Bovey, je l'ai déjà installé, mais le souci, c'est qu'il ne fonctionne qu'en 32 Bits et je ne dispose que d'un PC en 64 bits !! ^^

Dans tous les cas, je regarderai mon code demain et en effectuerai les modifications afin de diminuer le temps de cycle.

Merci encore !

Cordialement.

GK

[clementmarcotte]

Bonjour,

Concernant le logiciel de Rob Bovey, je l'ai déjà installé, mais le souci, c'est qu'il ne fonctionne qu'en 32 Bits et je ne dispose que d'un PC en 64 bits !! ^^

GK

Ce n'est pas la version 64 bits de Windows qui compte, mais la version de 64 bits d'Office. À partir d'Office 2010, on peut avoir Office en 32 bits ou en 64 bits et les deux peuvent être utilisés sur un Windows 64 bits. Là ce sont les bits d'Office qu'il faut vérifier.

Ceci dit, avec tout Excel, un truc qui pourrait marcher, c'est d'exporter ton module (clic droit sur l'icône du module dans l'Explorateur de projet), de le supprimer dans l'explorateur et de le réimporter. En principe, le ménage devrait se faire.

[Ghost0000]

Salut à toi,

En général dans ce genre de situation, la macro s'emballe car tu ajoutes une ligne, quand il passe à la "ligne suivante", il retombe sur celle qui était précédemment là et que tu as du coup décalée vers le bas ! Donc il rajoute encore une ligne, etc.

Fais plutôt comme ça, en passant par une boucle sur la ligne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Sub test()
'Saut de ligne entre chaque opération
        Dim ligne As Integer
        For ligne = 2 To Range("A65536").End(xlUp).Row
            If Cells(ligne - 1, "A") <> Cells(ligne, "A") Then Rows(ligne).Insert: ligne = ligne + 1
        Next ligne
End Sub

Le souci avec le for each, c'est que tu ne peux pas décaler le prochain "c" de ta boucle (ou du moins je ne sais pas le faire)... il passe automatiquement sur celui que tu ne veux pas (tu pourrais tester si la ligne est vide et du coup ne rien faire pour que ça passe bien à la suivante, mais avec les lignes comme je propose ça marche très bien !).

En espérant que ça t'aide !

Merci pour le tuto sur le cleaner du code VBA je viens également de reparcourir le code et j'ai réfléchi sur des opérations plus simple a réalisé, mon code est passé de 62 Mo à 4 Mo, puis ensuite à 200 Ko !!!

Le code ne fonctionne pas tout à fait en réalité, je viens de tester, lors des premières lignes, il réalise bien les opérations demandées, c'est une fois qu'il à réaliser certains ajout de lignes au début qu'après, il n'ajoute plus les suivantes...
Voici le code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
    'Saut de ligne entre chaque opération
        Dim ligne As Integer
        For ligne = 2 To Range("A65536").End(xlUp).Row
            If Cells(ligne - 1, "A") <> Cells(ligne, "A") Then Rows(ligne).Insert: ligne = ligne + 1
        Next ligne

Voici le résultat :

203307 10 200046976 4400 1
203307 10 200046977 4400 1,06
203307 10 200046978 4400 1,15
203307 10 200046979 4400 1,16

203308 40 200046979 4400 1,16
203308 40 200046980 4400 1
203308 40 200046981 4400 1,06

203310 20 200046986 4400 1,15
203310 20 200046987 4400 1,16
203310 20 200046988 4400 1,16

203311 10 200046976 4400 1
203311 10 200046977 4400 1,06
203312 20 200046986 4400 1,15
203312 20 200046987 4400 1,16
203313 40 200046979 4400 1,16
203313 40 200046980 4400 1
203313 40 200046981 4400 1,06
203315 20 200046986 4400 1,15
203315 20 200046987 4400 1,16

Le but ici étant de rajouter une ligne entre 203311 et 203312, même chose entre 203312 et 203313 et même chose entre 203313 et 203315....etc etc

[Invité]

Bonsoir,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
'Saut de ligne entre chaque opération
        Dim c As Range
        For  c = Range("A" & celle.rows.count).End(xlUp).row to 2 step-1
            If cells(c,1).Offset(-1,0) <> cells(c,1) Then cells(c,1).EntireRow.Insert
        Next

[Ghost0000]

Tout d'abord Bonsoir et Merci pour l'aide rdurupt !

Il me surligne le "c" juste après le "FOR" et me dit l'erreur : incompatibilité de Type
Problème de déclaration de variable ??? enfin je pense ?

[Ghost0000]

Il faudrait que j arrive à tester si j ai une ligne vide ou non, après plusieurs essaies, je n y arrive pas.
Je vais regarder une nouvelle fois ce soir.

Merci !!

Gk

[Invité]

Bonjour,
Désolé!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Dim c As integer

[Ghost0000]

Erreur d exécution '424'
Objet requis

Dans ton For il y a un 'Celle" , il faut mettre "cells" non ??
Même avec celle, cells ou cell... Ça me surligne "Cells.row" que j ai remplacé par Cells.rows, donc après ça passe cette ligne de code sans souci.

Dans la ligne if jusqu'à Then, il me surligne cette section et met met : erreur définie par l application ou par l objet (1004)...

[Invité]

quand on écrit directement sur le forum, on prend des risques! sorry

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Dim c As Integer
        For c = Range("A" & Cells.Rows.Count).End(xlUp).Row To 2 Step -1
            If Cells(c, 1).Offset(-1) <> Cells(c, 1) Then Cells(c, 1).EntireRow.Insert
        Next

[Ghost0000]

Rdurupt merci c est super !!!

Je suis au milieu de génie ^^

Gk