Problème boucle sur plusieurs feuilles

didy -  
 didy -
Bonjour,
Comme beaucoup de mon de sur ce forum j'ai l'impression je viens de commencer un stage et je buche sur ma première macro. Elle est trop longue, peu efficiente et bloque une fois sur deux, mais ne soyez pas trop durs, j'essaie de faire mon max. Alors l'idée c'est que je travaille à partir de deux supports de données que je colle dans mon classeur et à partir de là je vais alimenter 9 feuilles (dont les numéros ne se suivent pas du tout, oups!).
Ne sachant pas faire une boucle qui agisse sur chaque feuille j'ai recopier le code neuf fois en changeant les noms, résultat la macro met dix minutes à charger et encore qd je la fragmente (impossible de l'enchainer en entier).

Voici un exemple:

i = 2
Do Until Feuil2.Cells(i, 1) = "" And Feuil2.Cells(i + 1, 1) = "" And Feuil2.Cells(i + 2, 1) = "" And Feuil2.Cells(i + 3, 1) = "" And Feuil2.Cells(i + 4, 1) = "" And Feuil2.Cells(i + 5, 1) = "" And Feuil2.Cells(i + 6, 1) = ""
If Feuil2.Cells(i, 1).Value = "SUR / sous pondération" Then Feuil2.Cells(i, 1).EntireRow.Delete
If Feuil2.Cells(i, 1).Value = "ISHARES DJ STOXX 600 BKS DE" Then Feuil2.Cells(i, 1).EntireRow.Delete
If Feuil2.Cells(i, 1).Value = "Publicité & médias" Then Feuil2.Cells(i, 1).EntireRow.Delete
If Feuil2.Cells(i, 1).Value = "ISHARES DJ ST 600 INSURAN DE" Then Feuil2.Cells(i, 1).EntireRow.Delete
If Feuil2.Cells(i, 1).Value = "" Then Feuil2.Cells(i, 49).EntireRow.Delete

i = i + 1

Loop

i = 2
Do Until Feuil3.Cells(i, 1) = "" And Feuil3.Cells(i + 1, 1) = "" And Feuil3.Cells(i + 2, 1) = "" And Feuil3.Cells(i + 3, 1) = "" And Feuil3.Cells(i + 4, 1) = "" And Feuil3.Cells(i + 5, 1) = "" And Feuil3.Cells(i + 6, 1) = ""
If Feuil3.Cells(i, 1).Value = "SUR / sous pondération" Then Feuil3.Cells(i, 1).EntireRow.Delete
i = i + 1
If Feuil3.Cells(i, 1).Value = "ISHARES DJ STOXX 600 BKS DE" Then Feuil3.Cells(i, 1).EntireRow.Delete
i = i + 1
If Feuil3.Cells(i, 1).Value = "Publicité & médias" Then Feuil3.Cells(i, 1).EntireRow.Delete

i = i + 1
If Feuil3.Cells(i, 1).Value = "ISHARES DJ ST 600 INSURAN DE" Then Feuil3.Cells(i, 1).EntireRow.Delete
If Feuil3.Cells(i, 1).Value = "" Then Feuil3.Cells(i, 1).EntireRow.Delete
i = i + 1
Loop

i = 2
Do Until Feuil4.Cells(i, 1) = "" And Feuil4.Cells(i + 1, 1) = "" And Feuil4.Cells(i + 2, 1) = "" And Feuil4.Cells(i + 3, 1) = "" And Feuil4.Cells(i + 4, 1) = "" And Feuil4.Cells(i + 5, 1) = "" And Feuil4.Cells(i + 6, 1) = ""
'supprime les lignes qui ne sont pas des valeurs dans la colonne 1
If Feuil4.Cells(i, 1).Value = "SUR / sous pondération" Then Feuil4.Cells(i, 1).EntireRow.Delete
If Feuil4.Cells(i, 1).Value = "ISHARES DJ STOXX 600 BKS DE" Then Feuil4.Cells(i, 1).EntireRow.Delete
If Feuil4.Cells(i, 1).Value = "Publicité & médias" Then Feuil4.Cells(i, 1).EntireRow.Delete
If Feuil4.Cells(i, 1).Value = "ISHARES DJ ST 600 INSURAN DE" Then Feuil4.Cells(i, 1).EntireRow.Delete
If Feuil4.Cells(i, 1).Value = "" Then Feuil4.Cells(i, 1).EntireRow.Delete
i = i + 1
Loop

... et ainsi de suite. D'ailleurs je pense que je pourrait simplifier chacune des parties si vous avez des idées.

Vous me sauveriez la vie si vous m'aidiez, ce stage est tres important pour moi et la macro de départ est un peu le bizutage test.

Merci d'avance.

2 réponses

didy
 
Alors pour schématiser
Base de données 1:feuil1

NomsA B C D
1 0,1 0,3 0,1 0,3
2 0,1 0,3

3 0,1 0,3 0,1 0,1
4 0,1 0,3
5 0,1 0,3 0,1 0,3

A, B, C, D sont des paniers et les données representent le poids de chaque nom dans les paniers

Base de données 2:feuil2
Noms X1 X2 X3 X4
1 12 13 14 11
2

3
4
5

A chaque nom sont associées des données complémentaires X1 X2 X3 X4

En fait, je voulais faire tourner ma boucle jusqu'à avoir une case vide mais il y en a partout disséminées dans la base de données. Je tente donc de la faire tourner jusqu'à ce que 6 cellules de suite de la colonne concernée soient vides.

J'attribue, une feuil pour chaque panier
Sur chacune d'elles:

1) En feuil3, je colle les noms de la première colonne de la base de données 1
Avant d'aller plus loin je supprime les lignes dont une des case correspond à des valeurs qui ne m'interessent pas, par exemple je vire les ligne dont la premiere cellule est vide, ou =0...

2) Avec une fonction Vlookup j'associe à chaque nom le poids qui lui correspond
3) Même chose mais à partir de la case de données 2, pour chaque valeur, j'associe la ligne entière qui correspond
4) De là je rajoute sur chaque ligne donc pour chaque nom quatre colonnes qui correspondront à la multiplication du poids et respectivement, des données complémentaires
5) Enfin pour chaque données complémentaire, je ferai le total de la colonne.

Est ce que je suis plus claire?

Le début...
Private Sub Valeurs_Click()
Feuil2.Cells(2, 1) = Feuil1.Cells(85, 12)
Feuil3.Cells(2, 1) = Feuil1.Cells(85, 12)
Feuil4.Cells(2, 1) = Feuil1.Cells(85, 12)
Feuil5.Cells(2, 1) = Feuil1.Cells(85, 12)
Feuil6.Cells(2, 1) = Feuil1.Cells(85, 12)
Feuil7.Cells(2, 1) = Feuil1.Cells(85, 12)
Feuil8.Cells(2, 1) = Feuil1.Cells(85, 12)
Feuil9.Cells(2, 1) = Feuil1.Cells(85, 12)

i = 85
While Feuil1.Cells(i, 12) <> ""
If Feuil1.Cells(i, 12) <> "XXXX" Then i = i + 1 Else i = i + 6

Feuil2.Cells(i - 83, 1) = Feuil1.Cells(i, 12)
Feuil3.Cells(i - 83, 1) = Feuil1.Cells(i, 12)
Feuil4.Cells(i - 83, 1) = Feuil1.Cells(i, 12)
Feuil5.Cells(i - 83, 1) = Feuil1.Cells(i, 12)
Feuil6.Cells(i - 83, 1) = Feuil1.Cells(i, 12)
Feuil7.Cells(i - 83, 1) = Feuil1.Cells(i, 12)
Feuil8.Cells(i - 83, 1) = Feuil1.Cells(i, 12)
Feuil9.Cells(i - 83, 1) = Feuil1.Cells(i, 12)

Wend

i = 2
Do Until Cells(i, 1) = "" And .Cells(i + 1, 1) = "" And Cells(i + 2, 1) = "" And Cells(i + 3, 1) = "" And Cells(i + 4, 1) = "" And Cells(i + 5, 1) = "" And Cells(i + 6, 1) = ""
For Each Worksheet In Workbook
If Cells(i, 1).Value = "XXXX" Then Cells(i, 1).EntireRow.Delete
If Cells(i, 1).Value = "ZZZZ" Then Cells(i, 1).EntireRow.Delete
If Cells(i, 1).Value = "Publicité & médias" Then Cells(i, 1).EntireRow.Delete
If Cells(i, 1).Value = "AAAAAAA" Then Cells(i, 1).EntireRow.Delete
If Cells(i, 1).Value = "" Then Cells(i, 49).EntireRow.Delete

i = i + 1

Loop
Next

i = 2
Do Until Feuil3.Cells(i, 1) = "" And Feuil3.Cells(i + 1, 1) = "" And Feuil3.Cells(i + 2, 1) = "" And Feuil3.Cells(i + 3, 1) = "" And Feuil3.Cells(i + 4, 1) = "" And Feuil3.Cells(i + 5, 1) = "" And Feuil3.Cells(i + 6, 1) = ""
If Feuil3.Cells(i, 1).Value = "XXXX" Then Feuil3.Cells(i, 1).EntireRow.Delete
i = i + 1
If Feuil3.Cells(i, 1).Value = "ZZZZ" Then Feuil3.Cells(i, 1).EntireRow.Delete
i = i + 1
If Feuil3.Cells(i, 1).Value = "Publicité & médias" Then Feuil3.Cells(i, 1).EntireRow.Delete

i = i + 1
If Feuil3.Cells(i, 1).Value = "AAAA" Then Feuil3.Cells(i, 1).EntireRow.Delete
If Feuil3.Cells(i, 1).Value = "" Then Feuil3.Cells(i, 1).EntireRow.Delete
i = i + 1
Loop
1
jjsteing Messages postés 1803 Statut Contributeur 181
 
bonjour,

Do Until Feuil2.Cells(i, 1) = "" And Feuil2.Cells(i + 1, 1) = "" And Feuil2.Cells(i + 2, 1) = "" And Feuil2.Cells(i + 3, 1) = "" And Feuil2.Cells(i + 4, 1) = "" And Feuil2.Cells(i + 5, 1) = "" And Feuil2.Cells(i + 6, 1) = ""
If Feuil2.Cells(i, 1).Value = "SUR / sous pondération" Then Feuil2.Cells(i, 1).EntireRow.Delete

deja, rien qu aux 2 premiere ligne, y a un bug :

dans ton do until, tu va vérifier si ta cellule i,1 ou i,2... )"" et donc si elles son vide, tu verifie si il y a qlqchose dedans pour supprimer toute la colone....

y a comme un paradoxe...

Mais bon, explique nous ce que tu veux faire exactement dans ta macro et on ferra de notre mieux
0