Comment insérer une ligne vide à chaque changement de valeur

[geraldine69]

Bonoir,

Je suis à la recherche d'une petite macro me permettant d'insérer une ligne vide à chaque changement de valeur sur une colonne donnée.

Exemple si j'ai une série de ce type

A 0 1 2 3 4 5 6 7 8 9
A 1 2 3 4 5 6 7 8 9 0
A 2 3 4 5 6 7 8 9 0 1
B 0 1 2 3 4 5 6 7 8 9
B 1 2 3 4 5 6 7 8 9 0
B 2 3 4 5 6 7 8 9 0 1
C 0 1 2 3 4 5 6 7 8 9
C 1 2 3 4 5 6 7 8 9 0
C 2 3 4 5 6 7 8 9 0 1

J'aimerais obtenir ceci :

A 0 1 2 3 4 5 6 7 8 9
A 1 2 3 4 5 6 7 8 9 0
A 2 3 4 5 6 7 8 9 0 1

B 0 1 2 3 4 5 6 7 8 9
B 1 2 3 4 5 6 7 8 9 0
B 2 3 4 5 6 7 8 9 0 1

C 0 1 2 3 4 5 6 7 8 9
C 1 2 3 4 5 6 7 8 9 0
C 2 3 4 5 6 7 8 9 0 1


Merci


Géraldine

 

[marat70]

Re : Comment insérer une ligne vide à chaque changement de valeur

Re,

Voyez ce que donne cette macro sur votre fichier :

Sub InsererLignes()
Dim t, ncol%, rest(), j%, i&, n&, x$, y$
With ActiveSheet
  t = .Range("A1:A2", .UsedRange).Formula
  ncol = UBound(t, 2)
  If ncol < 23 Then Exit Sub 'sécurité
  ReDim rest(1 To 2 * UBound(t), 1 To ncol)
  For j = 1 To ncol: rest(1, j) = t(1, j): Next
  n = 1
  For i = 2 To UBound(t)
    n = n + 1
    x = Trim(t(i - 1, 3) & " " & t(i - 1, 5) & " " & t(i - 1, 23))
    y = Trim(t(i, 3) & " " & t(i, 5) & " " & t(i, 23))
    If x <> "" And y <> "" And x <> y Then n = n + 1
    For j = 1 To ncol
      rest(n, j) = t(i, j)
  Next j, i
  .Columns(23).NumberFormat = "dd/mm/yy"
  .[A1].Resize(n, ncol) = rest
End With
End Sub

Elle est très rapide même sur un très grand tableau.

Bien sûr il ne faut pas de couleurs dans le tableau car elles sont ignorées.

A+

Bonjour,

La macro fonctionne parfaitement sur le fichier testé ce matin... Merci

Question juste pour que je puisse comprendre la macro , est ce que vous pourriez me l 'expliquer dans le cas ou j 'aurai besoin de changer de colonnes

 

[job75]

Re : Comment insérer une ligne vide à chaque changement de valeur

Bonjour marat70, le forum,

Les numéros des 3 colonnes sont 3 (C) 5 (E) et 23 (W).

Il sont utilisés dans le test ncol < 23, dans le calcul de x et y et à la fin avec .Columns(23).

Bonne journée.

 

[marat70]

Re : Comment insérer une ligne vide à chaque changement de valeur

Merci beaucoup, je testerai sur un autre fichier avec des colonne différentes...

 

[job75]

Re : Comment insérer une ligne vide à chaque changement de valeur

Re,

Au post #15 j'ai remplacé .Formula par .FormulaR1C1 (en cas de formules dans les autres colonnes).

A+

 

[marat70]

Re : Comment insérer une ligne vide à chaque changement de valeur

Bonjour,

Je reviens vers vous concernant la macro

Sub InsererLignes()
Dim t, ncol%, rest(), j%, i&, n&, x$, y$
With ActiveSheet
t = .Range("A1:A2", .UsedRange).Formula
ncol = UBound(t, 2)
If ncol < 23 Then Exit Sub 'sécurité
ReDim rest(1 To 2 * UBound(t), 1 To ncol)
For j = 1 To ncol: rest(1, j) = t(1, j): Next
n = 1
For i = 2 To UBound(t)
n = n + 1
x = Trim(t(i - 1, 3) & " " & t(i - 1, 5) & " " & t(i - 1, 23))
y = Trim(t(i, 3) & " " & t(i, 5) & " " & t(i, 23))
If x <> "" And y <> "" And x <> y Then n = n + 1
For j = 1 To ncol
rest(n, j) = t(i, j)
Next j, i
.Columns(23).NumberFormat = "dd/mm/yy"
.[A1].Resize(n, ncol) = rest
End With
End Sub


serait-il possible de ne pas mettre de condition de forme pour la colonne 23 en date, dans le cas ou mon tableau ne soit pas fait de la même facon ?

J'ai essayé de supprimer la ligne .Columns(23).NumberFormat = "dd/mm/yy"
mais la macro ne fonctionne plus correctement.

merci de votre aide

 

[job75]

Re : Comment insérer une ligne vide à chaque changement de valeur

Bonjour marat70,

Vous pouvez sans problème supprimer l'instruction .Columns(23).NumberFormat = "dd/mm/yy"

Il suffit que vous ayez formaté auparavant toute la colonne 23 au format que vous voulez.

C'est d'ailleurs la même chose pour les autres colonnes.

A+

 

[marat70]

Re : Comment insérer une ligne vide à chaque changement de valeur

Bonjour à tous,
je suis de retour, est ce que vous pourriez me modifier la macro, afin de sauter une ligne selon une colonne définie a chaque changement de valeur. sachant que la colonne peut être en format date ou texte ou nombre selon les cas ... merci d'avance

 

[A.by1709]

Bonsoir,
Je recherche une macro pour me permettre d'inserer un ligne a chaque fois le mot "prix5" apparait dans la colonne.
c'est urgent merci

 

[job75]

Bonsoir A.by1709,

Pour changer on utilise ici des colonnes auxiliaires, c'est très rapide aussi.

D'abord si l'on veut supprimer toutes les lignes vides de la feuille :

Sub SupprimerLignesVides()
Dim cc%
Application.ScreenUpdating = False
With ActiveSheet.UsedRange
  If .Parent.FilterMode Then .Parent.ShowAllData 'si la feuille est filtrée
  cc = .Columns.Count
  .Columns(cc + 1) = "=1/SIGN(COUNTIF(RC1:RC[-1],""><""))"
  .Columns(cc + 1) = .Columns(cc + 1).Value 'supprime les formules
  .Resize(, cc + 1).Sort .Columns(cc + 1), xlAscending 'tri pour placer les valeurs d'erreur en bas
  On Error Resume Next 'si aucune valeur d'erreur
  .Columns(cc + 1).SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete
  .Columns(cc + 1).EntireColumn.Delete 'supprime la colonne auxiliaire
  With .Parent.UsedRange: End With 'actualise les barres de défilement
End With
End Sub

Ensuite pour insérer des lignes vides au-dessus de "prix5" :

Sub InsérerLignesVides()
Dim x$, r As Range, cc%, ad$
x = "prix5" 'texte recherché, à adapter
Application.ScreenUpdating = False
With ActiveSheet.UsedRange
  If .Parent.FilterMode Then .Parent.ShowAllData 'si la feuille est filtrée
  Set r = .Find(x, , xlValues, xlWhole)
  If r Is Nothing Then Exit Sub
  cc = .Columns.Count
  ad = .Rows(1).Address
  .Cells(1, cc + 1) = 1: .Columns(cc + 1).DataSeries 'repère l'ordre initial
  .Columns(cc + 2).FormulaR1C1 = "=1/(RC" & r.Column & "<>""" & x & """)"
  .Columns(cc + 2) = .Columns(cc + 2).Value 'supprime les formules
  .Resize(, cc + 2).Sort .Columns(cc + 2), xlAscending 'tri pour placer les valeurs d'erreur en bas
  Set r = .Columns(cc + 2).SpecialCells(xlCellTypeConstants, 16).Offset(, -1)
  r.EntireRow.Insert 'insère les lignes
  r.Offset(-r.Count) = r.Value 'numérote les lignes vides insérées
  .Parent.Range(.Parent.Range(ad), r).Sort .Columns(cc + 1), xlAscending 'tri dans l'ordre initial
  .Columns(cc + 1).Resize(, 2).EntireColumn.Delete 'supprime les 2 colonnes auxiliaires
  If Application.CountA(.Parent.Range(ad)) = 0 Then .Parent.Range(ad).EntireRow.Delete
End With
End Sub

On suppose que tous les "prix5" sont dans une même colonne.

Bonne fin de soirée.

Edit : testé avec 100 000 "prix5" en colonne A :

- InsérerLignesVides => 1,2 seconde

- SupprimerLignesVides => 8 secondes (200 000 lignes).