Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Insertion de ligne en fonction de valeur d'une cellule

Créer une discussion
  • Initiateur de la discussion Initiateur de la discussion momo
  • 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
M

momo

XLDnaute Occasionnel
Je voudrais Insérer des lignes en fonction des valeurs se trouvant dans la colonne H ; La Macro ci après est celle que j'essaie sans succès . Pourriez vous me porter un pti coup d'aide
Merci

La Macro

Sub insererLig()
Dim lig As Long
Application.ScreenUpdating = False
For lig = Cells(Rows.Count, 2).End(xlUp).Row To 2 Step -1
If Cells(lig, "B") <> Cells(lig + 1, "B") And Cells(lig, "H") > 0 Then
Rows(lig + 1).Resize(Cells(lig, "H")).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Cells(lig + 1, 2).Resize(Cells(lig, "H"), 1) = Cells(lig, "B")
End If
Next lig
Application.ScreenUpdating = True
End Sub
 

Pièces jointes

Solution
Re : Insertion de ligne en fonction de valeur d'une cellule

Bonjour momo,

Pour terminer voici je pense une solution meilleure.

Les lignes dont la colonne H n'est pas vide sont toujours traitées :

Code: 
Sub InsererLignes()
Dim t, ref, rest(), i&, n&, j As Byte, k&
With [A1].CurrentRegion.Resize(, 8).Offset(1)
  t = .FormulaR1C1
  ref = .Columns(8)
  ReDim rest(0 To Application.CountA(.Columns(8)) _
    + Application.SumIf(.Columns(8), ">0"), 1 To 8)
End With
For i = 1 To UBound(t) - 1
  If Not IsEmpty(ref(i, 1)) Then
    For j = 1 To 8: rest(n, j) = t(i, j): Next
    If ref(i, 1) > 0 Then
      For k = n + 1 To n + ref(i, 1)
        For j = 1 To 6
          rest(k, j) = t(i, j)
      Next j, k
      n =...
Trier par date Trier par votes
Re : Insertion de ligne en fonction de valeur d'une cellule

Bonsoir momo,

Il suffirait de quelques lignes montrant le résultat désiré pour qu'on puisse donner la solution adéquate.

A+
 
Vote positif 0 Vote négatif
Re : Insertion de ligne en fonction de valeur d'une cellule

Bonsoir Job

Merci de bien vouloir me porter votre aide

Je joins le fichier avec quelques exemples de ce que devrait donner le résultat attendu

Merci encore
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Insertion de ligne en fonction de valeur d'une cellule

Bonjour momo,

A partir des exemples fournis voici 2 solutions dans les fichiers joints :

Code: 
Sub InsererLignes()
Dim derlig As Long, lig As Long
Application.ScreenUpdating = False
derlig = Cells(Rows.Count, 2).End(xlUp).Row
For lig = derlig To 2 Step -1
  If IIf(lig = derlig, True, Cells(lig + 1, 8) <> "") And Cells(lig, 8) > 0 Then
    Rows(lig + 1).Resize(Cells(lig, 8)).Insert
    Cells(lig, 1).Resize(, 6).Copy Cells(lig + 1, 1).Resize(Cells(lig, 8), 6)
  End If
Next lig
End Sub
Code: 
Sub InsererLignes()
Dim t, ref, rest(), h&, i&, n&, j As Byte, k&
With [A1].CurrentRegion.Resize(, 8).Offset(1)
  t = .FormulaR1C1
  ref = .Columns(8)
  ReDim rest(1 To UBound(t) + Application.SumIf(.Columns(8), ">0"), 1 To 8)
End With
h = UBound(t) - 1
For i = 1 To h
  n = n + 1
  For j = 1 To 8: rest(n, j) = t(i, j): Next
  If IIf(i = h, True, ref(i + 1, 1) <> "") And ref(i, 1) > 0 Then
    For k = n + 1 To n + ref(i, 1)
      For j = 1 To 6
        rest(k, j) = t(i, j)
    Next j, k
    n = n + ref(i, 1)
  End If
Next i
If n Then [A2].Resize(n, 8) = rest
End Sub
La 2ème solution utilise des tableaux VBA, elle est beaucoup plus rapide.

A+
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Re : Insertion de ligne en fonction de valeur d'une cellule

Re,

J'ai copié le tableau de 358 lignes jusqu'à la ligne 10741.

Sur Win 8 - Excel 2013 la 1ère solution s'exécute en 21 secondes.

La seconde solution (tableaux VBA) en 0,56 seconde.

Bonne fin de soirée.
 
Vote positif 0 Vote négatif
Re : Insertion de ligne en fonction de valeur d'une cellule

Bonjour momo,

Pour terminer voici je pense une solution meilleure.

Les lignes dont la colonne H n'est pas vide sont toujours traitées :

Code: 
Sub InsererLignes()
Dim t, ref, rest(), i&, n&, j As Byte, k&
With [A1].CurrentRegion.Resize(, 8).Offset(1)
  t = .FormulaR1C1
  ref = .Columns(8)
  ReDim rest(0 To Application.CountA(.Columns(8)) _
    + Application.SumIf(.Columns(8), ">0"), 1 To 8)
End With
For i = 1 To UBound(t) - 1
  If Not IsEmpty(ref(i, 1)) Then
    For j = 1 To 8: rest(n, j) = t(i, j): Next
    If ref(i, 1) > 0 Then
      For k = n + 1 To n + ref(i, 1)
        For j = 1 To 6
          rest(k, j) = t(i, j)
      Next j, k
      n = n + ref(i, 1)
    End If
    n = n + 1
  End If
Next i
If n Then [A2].Resize(n, 8) = rest
End Sub
Fichier (2).

La durée d'exécution est inchangée.

Mais si après traitement on supprime des lignes "vides" elles seront restituées au traitement suivant.

A+
 

Pièces jointes

Vote positif 0 Vote négatif
Solution
Re : Insertion de ligne en fonction de valeur d'une cellule

Re,

Notez enfin qu'il est facile de supprimer les lignes insérées (vides en colonne H) :

Code: 
Sub SupprimerLignes()
Dim t, i&, n&, j As Byte
t = [A1].CurrentRegion.Resize(, 8).Offset(1).FormulaR1C1
For i = 1 To UBound(t) - 1
  If t(i, 8) <> "" Then
    n = n + 1
    For j = 1 To 8
      t(n, j) = t(i, j)
    Next j
  End If
Next i
If n Then [A2].Resize(n, 8) = t
[A2].Offset(n).Resize(UBound(t) - n, 8).ClearContents
With ActiveSheet.UsedRange: End With 'actualise la barre de défilement
End Sub
Fichier joint.

A+
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Insertion de ligne en fonction de valeur d'une cellule

Re,

Une dernière précision.

S'il y a un texte ou une valeur d'erreur en colonne H les macros InsérerLignes précédentes beuguent.

Un bug est toujours utile pour signaler une bêtise mais on peut l'éviter en ajoutant le test :

Code: 
If IsNumeric(ref(i, 1)) Then
Fichier (2).

Edit : pour l'entrée éventuelle de nombres décimaux j'utilise 2 * Application.CountA(.Columns(8))

Bonne fin de soirée.
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Re : Insertion de ligne en fonction de valeur d'une cellule

Bonjour Job,

J'ai essayé la dernière méthode proposée, je suis vraiment scotché..

Vous avez même anticipé sur les problèmes que je pourrai avoir et la solution de suppression des lignes iunsérées est géniale ... J'avais voulu revenir sur l'insertion et franchement j'ai été bluffé

Merci encore pour toute l'aide que vous m'avez porté
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
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

A
  • Résolu(e)
XL 2016 Recherche d'un mot dans une cellule et surlignage de la ligne
Réponses
4
Affichages
550
Abi23
A
  • Résolu(e)
XL 2016 Mettre la même couleur de la dernière cellule colorée
Réponses
5
Affichages
514
TooFatBoy
F
  • Question Question
Microsoft 365 Problème mémoire insuffisante
Réponses
5
Affichages
834
TooFatBoy
  • Question Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
2 K
Nicolas JACQUIN
J
  • Résolu(e)
Microsoft 365 Première cellule vide ou égal zéros dans une plage définie
Réponses
11
Affichages
389
juju91
J
M
  • Question Question
Microsoft 365 Modifier code et format textbox
2 3
Réponses
35
Affichages
2 K
Marvin57
M
  • Résolu(e)
Microsoft 365 Découper un fichier en plusieurs fichiers
2
Réponses
24
Affichages
677
nat54
L
  • Résolu(e)
Microsoft 365 Suppression de cellules vide
Réponses
3
Affichages
569
Le Rouky
L
F
  • Résolu(e)
Autres Insérer une ligne
2 3
Réponses
36
Affichages
3 K
francescofrancesco
F
C
  • Question Question
Microsoft 365 Supprimer ligne selon contenu cellule (résolu)
Réponses
7
Affichages
398
job75
C
  • Question Question
Microsoft 365 worksheet_change
2
Réponses
29
Affichages
1 K
CortoXls
C
L
  • Résolu(e)
Microsoft 365 Extraire les données de la valeur cherchée en note
Réponses
5
Affichages
429
Lau01150
L
  • Résolu(e)
Microsoft 365 VBA - BeforeDoubleClick, 1ère cellule vide à partir de cellule active pour insertion de ligne
Réponses
4
Affichages
410
AlCapone
S
  • Question Question
XL 2019 probleme dans une macro a la suite d un rajout de condition
Réponses
2
Affichages
554
snoopy07
S
R
  • Résolu(e)
XL 2019 macro couper-coller sur plusieurs onglets
Réponses
9
Affichages
921
job75
  • Question Question
Microsoft 365 [VBA] Enchaîner déplacer lignes + supprimer les lignes vides.
Réponses
3
Affichages
1 K
ARMAEL
A
Y
  • Question Question
XL 2019 Masquer automatiquement des lignes selon la valeur d'une cellule ?
Réponses
2
Affichages
479
Yogean
Y
B
  • Question Question
Microsoft 365 [RESOLU] Supprimer Ligne rapidement et avec plusieurs conditions
Réponses
5
Affichages
525
BENAM69
B
  • Résolu(e)
XL 2016 En VBA, Automatiser la réponse en fonction de l'état d'une cellule.
Réponses
7
Affichages
784
piga25
S
  • Résolu(e)
XL 2019 Problème de remplissage cellule en vba
Réponses
5
Affichages
579
snoopy07
S
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…