Macro supprimer lignes & copier coller valeur d'une cellule dans X autres cellules

[neal]

Bonjour à tous !

J'ai besoin de faire des transformations sur des données, et comme mon fichier fait plusieurs dizaines de millier de lignes, j'ai besoin de votre aide pour automatiser cette tâche (j'ai supprimé des lignes pour que le fichier ne soit pas trop lourd).

J'explique d'abord rapidement. Il s'agit d'une extraction dont le format m'est imposé. J'ai mis le fichier en pièce jointe, avec d'autres explications à l'intérieur.
Je suis confronté à 3 problématiques liées à des ruptures dans le fichier, et une problématique de numéro de compte comptable :

• 1er type de rupture : saut de page (2 lignes à supprimer) ;
• 2ème type de rupture : total (1 ligne à supprimer) ;
• 3ème type de rupture : lignes pour un nouveau compte comptable (2 lignes, la première étant une ligne de titre à toujours supprimer. Par contre, il y a une opération à effectuer avant de supprimer la deuxième ligne : en colonne B se trouve le numéro à 8 chiffres du compte.
  [**]Toutes les lignes qui suivent cette rupture, jusqu’à la prochaine rupture de 3ème type (entre temps se trouvent des ruptures de 1er type et une rupture de 2ème type) ont en colonne G un numéro de compte à 6 chiffres seulement. Il faut remplacer tous les numéros à 6 chiffres par le numéro à 8 chiffres.[/INDENT]

Pour une meilleure compréhension, je vous explique ligne par ligne :

Ligne 1 : Titres de l’extraction (à supprimer)

Ligne 2 : Intitulés de colonnes (à conserver)

Ligne 3 : Titres du compte général (8 chiffres, voir cellule B3) --> ligne à supprimer seulement après avoir copié-collé le numéro de compte dans toutes les cellules de la colonne G correspondantes.

Ligne 4 à 71 : Écritures liées à ce compte --> lignes à conserver. Seules les cellules de la colonne G vont être transformées.

Lignes 72 et 73 : 1er type de rupture --> il s’agit seulement d’un saut de page (voir cellule B73, il n’y a pas de numéro de compte, seulement du texte) --> lignes à supprimer.

Lignes 74 à 1599 : Ecritures toujours liées au même compte qu’entre les lignes 4 à 71. MAIS toutes les 69 lignes, jusqu’à atteindre une ligne de total, il y a une rupture de 1er type --> deux lignes à supprimer.

Ligne 1600 : 2ème type de rupture Il s’agit du total des écritures qui sont situées des lignes 4 à 1598 --> Ligne à supprimer.

Ligne 1601 : 3ème type de rupture Il s’agit d’un nouveau compte (voir cellule B1601). On recommence la procédure.

 

[sousou]

Re : Macro supprimer lignes & copier coller valeur d'une cellule dans X autres cellul

bonjour
regarde si ce code correspond au résultat que tu cherches

ajoute un tri final pour supprimer les ligne vide

Sub deb()
Set zone = ActiveSheet.UsedRange.Rows
Set titre = ActiveSheet.Rows(2)
For Each i In zone
'test les ligne à effacer
If IsDate(i.Columns(1)) = False And IsNumeric(i.Columns(3)) = False And i.Row <> 2 Then
i.Columns(1) = "efface"
End If
'Si c'est une ligne renferment le compte : efface et mémorise le compte
If IsDate(i.Columns(1)) = False And IsNumeric(i.Columns(2)) = True Then
compte = i.Columns(2)
End If
'si c'est une ligne normale on modifie le numéro de compte
If IsDate(i.Columns(1)) = True Then
i.Columns(7) = compte
End If
Next
'effacement des lignes
For Each i In zone
If i.Columns(1) = "efface" Then i.EntireRow.Clear
Next
zone.Rows(1).EntireRow = titre
End Sub

 

[neal]

Re : Macro supprimer lignes & copier coller valeur d'une cellule dans X autres cellul

Alors voilà le code avec mes modifs :

Sub Macro1()
Set zone = ActiveSheet.UsedRange.Rows
Set titre = ActiveSheet.Rows(2)
zone.Rows(1).EntireRow = titre
For Each i In zone
If IsDate(i.Columns(1)) = False And i.Row <> 2 Then
i.Columns(1) = "efface"
End If
If IsDate(i.Columns(1)) = False And IsNumeric(i.Columns(2)) = True Then
compte = i.Columns(2)
End If
If IsDate(i.Columns(1)) = True Then
i.Columns(7) = compte
End If
Next
For Each i In zone
If i.Columns(1) = "efface" Then i.EntireRow.Delete
Next
For Each i In zone
If i.Columns(1) = "efface" Then i.EntireRow.Delete
Next
End Sub

Deux points :

1/ Je me retrouve avec deux lignes d'affilée qui ont "efface", du coup je suis obligé de doubler la partie du code qui efface les lignes ayant "efface" en colonne A.

2/ Le code fonctionne parfaitement sur une petite quantité de données. Je viens de le tester sur un fichier avec plus de 500000 lignes et ... Erreur 1004

 

[sousou]

Re : Macro supprimer lignes & copier coller valeur d'une cellule dans X autres cellul

re bonjour


j'avais parlé d'un tri pour finir.
Tu ne peux pas utiliser delete dans la fonction for next. elle te fait sauter des lignes.
Quant à l'erreur 1004 il faudrait plus de détail!
Voici le nouveau code complété
Sub deb()

Set zone = ActiveSheet.UsedRange.Rows
ActiveSheet.Rows(2).Copy (ActiveSheet.Rows(1))
For Each i In zone
If i.Row <> 1 Then
If IsDate(i.Columns(1)) = False And IsNumeric(i.Columns(3)) = False And i.Row <> 1 Then
i.Columns(1) = "efface"
End If
If IsDate(i.Columns(1)) = False And IsNumeric(i.Columns(2)) = True Then
compte = i.Columns(2)
End If
If IsDate(i.Columns(1)) = True Then
i.Columns(7) = compte
End If

End If
Next
For Each i In zone
If i.Columns(1) = "efface" Then i.EntireRow.Clear
Next
ActiveSheet.UsedRange.Sort key1:=ActiveSheet.Columns(1), Header:=xlYes
End Sub

 

[neal]

Re : Macro supprimer lignes & copier coller valeur d'une cellule dans X autres cellul

Bonjour,

merci pour vos réponses rapides.

L'erreur 1004 disparaît avec la deuxième version de la macro. Merci

Je n'avais pas ajouté de tri parce que, dans mon fichier final, les lignes qui n'ont pas une date dans la colonne A doivent être supprimées.
C'est pour cela que j'avais modifié le "Clear" par un "Delete" (sans savoir qu'on ne peut pas l'utiliser dans une fonction For Next --> Pourquoi d'ailleurs?)
Du coup, par quoi dois-je passer pour supprimer ces lignes? Sachant que mon vrai fichier va faire plusieurs millions de lignes.

 

[sousou]

Re : Macro supprimer lignes & copier coller valeur d'une cellule dans X autres cellul

re
Je n'ai pas le fichier sous les yeux, mais pour les lignes qui n'ont pas de date, ajoute un if dans la boucle qui ecrit "efface"
if i.columns(1)="" then i.columns(1)="efface"

explication:
lorsque tu définis une zone = aux cellules utilisées(usedrange)
la boucle va parcourir toutes les lignes de cette zone
si tu delete une ligne dans cette boucle, la zone va être modifiée.
si tu en es à la ligne 20,la ligne suivante sera la 21, tu supprime la ligne 20, et la 22 devient la 21 tu s sauté la 21
Pas très facile à expliquer, regarde en pas à pas ce qui se passe.

 

[neal]

Re : Macro supprimer lignes & copier coller valeur d'une cellule dans X autres cellul

Ok pour le if.

Oui le concept n'est pas facile à expliquer, mais j'ai suivi le chemin pas à pas et je l'ai compris.

Toujours dans le concept, ce que je ne comprends pas, c'est pourquoi est-ce que je ne peux pas insérer dans le code une ligne disant (en considérant que le Delete fonctionne avec un For Next... oui c'est conceptuel) :

For Each i In zone
If i.Columns(1) = "efface" Then i.EntireRow.Delete and i = i - 1
Next

Question de débutant sûrement ...

 

[sousou]

Re : Macro supprimer lignes & copier coller valeur d'une cellule dans X autres cellul

re
I n'est pas un compteur! tu trouverai un compteur dans les boucle for next de type
for i=0 to zone.count

next
mais for each i in zone gère des objets

lorsque tu dis
set zone= activesheet.usedrange.rows
zone est l'ensemble des objets 'ligne' de la plage zone utilisé
le nombre de ligne est zone.count

for each i in zone
donc i représente un objet ligne il n'a pas d'indice en tant que tel
sa position est données par i.row
si tu supprime la ligne cela change le nombre de ligne de la zone