Insérer une ligne en évitant les cellules fusionné avec VBA
Bonjour à tous,
Je suis débutant sur VBA (j'ai juste quelques bases)
J'ai besoin d'insérer une ligne toute les 10 lignes (pour l’exemple) sur mon tableau excel en y conditionnant avec VBA.
Mon problème c'est que j'ai des cellules fusionnées de tailles différentes et il ne faut pas que j'insert une ligne au milieu d'un groupe de cellule fusionné
Avez-vous une idée pour résoudre mon problème ?
Voir mon fichier Excel allégé ci-dessous.
Merci de votre réponse.
Bonne journée.
Bonjour,
les 2 contraintes ne sont pas compatibles et nécessitent plus d'explications.
toutes les 10 lignes, que faire quand on tombe dans un groupe ?
insérer la ligne avant le groupe ? après le groupe ? après l'insertion, on recompte 10 lignes ou on cherche le multiple de 10 lignes le plus proche ?
etc ...
merci de mettre un exemple de ce que tu veux obtenir comme résultat, avec tous les cas que tu veux voir traiter.
Bonjour h2so4
Il faudrait insérer une ligne toutes les 50 lignes (j'avais pris 10 pour exemple mais ça marche pas bien). Si on tombe dans un groupe il faudrait insérer la ligne au-dessus du groupe.
Et recompter 50 à partir de la ligne insérée.
Dans la colonne A les deux premiers caractères représentent la station et il faudrait aussi insérer une ligne avant le changement de station et à chaque insertion recompter 50.
J’espère que j'ai pu être plus clair.
bonjour,
une proposition, lancer la macro via alt-f8
Sub aargh()
Dim dl&, i&, ctr&, ligne&
With ActiveSheet
dl = .Cells(Rows.Count, 1).End(xlUp).Row 'dernière ligne
ctr = 1 'compteur de lignes
i = 1 'compteur de lignes groupe 50
Do While ctr < dl 'tant qu'il y a des lignes
If .Cells(ctr, 1) <> "" Then 'si ligne n'est pas blanche, on est sur la première ligne de cellules fusionnées
If i < 50 Then 'si le compteur de lignes groupe 50 est < 50
ligne = ctr ' on mémorise la ligne où il faudra potentiellement insérer une ligne blanche
Else
'sinon on est arrivé à 50 lignes
.Rows(ligne).Insert shift:=xlDown 'on insère une ligne en ligne ligne
i = ctr - ligne ' on adapte le compteur de lignes du groupe 50
ctr = ctr + 1 'on a ajouté une nouvelle ligne
ligne = ctr ' on mémorise la ligne où il faudra potentiellement insérer une ligne blanche
dl = dl + 1 'on adapte la dernière ligne
End If
End If
i = i + 1 ' incrémente le compteur de lignes groupe 50
ctr = ctr + 1 'incrémente le compteur de lignes
Loop ' on boucle
End With
End SubBonjour,
Merci de votre temps ça fonctionne bien
Je vais maintenant essayer d'ajouter des fonctionnalités.
Bonne journée.
La deuxième étape de ma macro serait d'insérer une ligne en plus entre deux stations
Dans la colonne A les deux premiers caractères représentent la station et il faudrait insérer une ligne avant le changement de station et à chaque insertion recomptée 50.
J'avais faits quelque chose comme ça:
Sub Notice()
Dim dl&, i&, ctr&, ligne&, station&, mmstation&
With ActiveSheet
dl = .Cells(Rows.Count, 1).End(xlUp).Row 'dernière ligne
ctr = 1 'compteur de lignes
i = 1 'compteur de lignes groupe 50
Do While ctr < dl 'tant qu'il y a des lignes
If .Cells(ctr, 1) <> "" Then 'si ligne n'est pas blanche, on est sur la première ligne de cellules fusionnées
station = Left(Feuil1.Range("A1").Offset(ctr), 2) 'Écriture des 2 premiers caratères de chaque cellule en A dans la variable
If i < 50 Then 'si le compteur de lignes groupe 50 est < 50
ligne = ctr ' on mémorise la ligne où il faudra potentiellement insérer une ligne blanche
End If
If i >= 50 Or station <> mmstation Then ' Si le compteur ligne groupe 50 est = ou > 50 ou si on change de station
station = mmstation 'Mémoire station
.Rows(ligne).Insert shift:=xlDown 'on insère une ligne en ligne
i = ctr - ligne ' on adapte le compteur de lignes du groupe 50
ctr = ctr + 1 'on a ajouté une nouvelle ligne
ligne = ctr ' on mémorise la ligne où il faudra potentiellement insérer une ligne blanche
dl = dl + 1 'on adapte la dernière ligne
End If
End If
i = i + 1 ' incrémente le compteur de lignes groupe 50
ctr = ctr + 1 'incrémente le compteur de lignes
Loop ' on boucle
End With
End SubMais vu que mes cellules sont fusionnés ça fonctionne pas.
Tu aurais une piste ?
Merci de ta réponse.
Petite adaptation (je sais c'est pas très optimisé)
Mais j'ai toujours le problème avec les cellules fusionnés
Sub Notice()
Dim dl&, i&, ctr&, ligne&, station&, mmstation&
With ActiveSheet
dl = .Cells(Rows.Count, 1).End(xlUp).Row 'dernière ligne
ctr = 1 'compteur de lignes
i = 1 'compteur de lignes groupe 50
Do While ctr < dl 'tant qu'il y a des lignes
If .Cells(ctr, 1) <> "" Then 'si ligne n'est pas blanche, on est sur la première ligne de cellules fusionnées
station = Left(Feuil1.Range("A1").Offset(ctr), 2) 'Écriture des 2 premiers caratères de chaque cellule en A dans la variable
If i < 47 Then 'si le compteur de lignes groupe 50 est < 50
ligne = ctr ' on mémorise la ligne où il faudra potentiellement insérer une ligne blanche
End If
If station <> mmstation Then 'si on change de station
station = mmstation 'Mémoire station
.Rows(ligne).Insert shift:=xlDown 'on insère une ligne en ligne
.Rows(ligne).Interior.Color = RGB(0, 0, 0) ' on met la ligne inséré en noir pour bien la voir
i = 0 ' on adapte le compteur de lignes du groupe 50
ctr = ctr + 1 'on a ajouté une nouvelle ligne
ligne = ctr ' on mémorise la ligne où il faudra potentiellement insérer une ligne blanche
dl = dl + 1 'on adapte la dernière ligne
End If
If i >= 47 Then 'Or station <> mmstation Then ' Si le compteur ligne groupe 50 est = ou > 50 ou si on change de station
.Rows(ligne).Insert shift:=xlDown 'on insère une ligne en ligne
.Rows(ligne).Interior.Color = RGB(0, 0, 0) ' on met la ligne inséré en noir pour bien la voir
i = ctr - ligne ' on adapte le compteur de lignes du groupe 50
ctr = ctr + 1 'on a ajouté une nouvelle ligne
ligne = ctr ' on mémorise la ligne où il faudra potentiellement insérer une ligne blanche
dl = dl + 1 'on adapte la dernière ligne
End If
End If
i = i + 1 ' incrémente le compteur de lignes groupe 50
ctr = ctr + 1 'incrémente le compteur de lignes
Loop ' on boucle
End With
End Subbonjour,
si j'ai bien compris
Sub aargh()
Dim dl&, i&, ctr&, ligne&
With ActiveSheet
dl = .Cells(Rows.Count, 1).End(xlUp).Row 'dernière ligne
'on insère les lignes de stations
stationprec = ""
i = 1
Do While i < dl
station = Left(.Cells(i, 1), 2)
If station <> stationprec And station <> "" Then
.Rows(i).Insert xlDown, xlFormatFromRightOrBelow
.Cells(i, 1) = "'" & station
i = i + 1
stationprec = station
End If
i = i + 1
Loop
ctr = 1 'compteur de lignes
i = 1 'compteur de lignes groupe 50
ligne = 1
Do While ctr < dl 'tant qu'il y a des lignes
If .Cells(ctr, 1) <> "" Then 'si ligne n'est pas blanche, on est sur la première ligne de cellules fusionnées
If i < 50 Then 'si le compteur de lignes groupe 50 est < 50
If Len(.Cells(ctr, 1)) = 2 Then 'on réinitialise le compteur groupe 50 si ligne station
i = 1
groupe = "'" & Left(.Cells(ctr, 1), 2)
End If
ligne = ctr ' on mémorise la ligne où il faudra potentiellement insérer une ligne blanche
Else
'sinon on est arrivé à 50 lignes
.Rows(ligne).Insert shift:=xlDown 'on insère une ligne en ligne ligne
.Cells(ligne, 1) = groupe
i = ctr - ligne ' on adapte le compteur de lignes du groupe 50
ctr = ctr + 1 'on a ajouté une nouvelle ligne
ligne = ctr ' on mémorise la ligne où il faudra potentiellement insérer une ligne blanche
dl = dl + 1 'on adapte la dernière ligne
End If
End If
i = i + 1 ' incrémente le compteur de lignes groupe 50
ctr = ctr + 1 'incrémente le compteur de lignes
Loop ' on boucle
End With
End SubC'est exactement ça,
Merci beaucoup !!
Bonne journée.