Macro Vérification puis changement de valeur

Bonjour,

J'ai créé il y a quelques temps de cela une macro qui parcoure un tableau excel, vérifie si une cellule contient un "2" et modifie son contenu en fonction. (si 4 cellules a la suite ont un "2" les valeurs sont prise aux cellules i-4).

Malheureusement la sortie de ma boucle n'est pas génial (l'argument étant la couleur de ma case que je modifie...) et cela apporte des problèmes. Je voudrais donc savoir si quelqu'un pouvait m'indiquer comment améliorer cette macro, pour :

1/ Eviter de reparcourir le tableau depuis le début a chaque fois

2/ Trouver une autre condition de sortie de boucle.

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41

Sub verification() Application.ScreenUpdating = False ligne = Range("e65536").End(xlUp).Row Dim X As Integer Cells.Font.ColorIndex = 1 start: X = 0 Cells.Font.ColorIndex = 1 For i = 2 To ligne If Cells(i, 5).Value = "2" Then X = X + 1 End If If Cells(i - 1, 5).Value = "2" And Cells(i, 5).Value <> "2" Then GoTo copie End If If Cells(i, 5).Value = "" Then GoTo fin End If Next i     copie: For f = 2 To ligne If Cells(f, 5).Value = "2" And f > X Then Cells(f, 5).Value = Cells(f - X, 5).Value Cells(f, 5).Font.ColorIndex = 4 Cells(f, 9).Value = Cells(f - X, 9).Value Cells(f, 9).Font.ColorIndex = 4 Cells(f, 10).Value = Cells(f - X, 10).Value Cells(f, 10).Font.ColorIndex = 4 End If If Cells(f + 1, 5).Value <> "2" And Cells(f, 5).Font.ColorIndex <> 1 Then GoTo start End If If Cells(f, 5).Value = "" Then GoTo fin End If   Next f fin: End Sub

---

J'espère être clair (mais ce n'est pas évident à expliquer, si vous avez besoin de précision, ou même d'un exemple, je peux vous préparer ça!)

Merci d'avance! :mrgreen:

Bonjour,

Je ne comprend pas pourquoi tu appels la boucle copie (qui repart depuis le début). tu devrais gérer les modifs directement dans le if (ligne 14)

A noter que pour sortir d'une boucle for il est plus propre d'écrire Exit For à la place de Goto fin

Bonjour

Je veux bien une vingtaine de ligne pour faire les test.
Sinon je crois que ceci fait cela (a quelque reglage prés).

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15

Sub devellopez() Dim cell As Range Dim i As Integer For Each cell In Range("e2:e" & Range("e65536").End(xlUp).Row) Cells(cell.Row, 5).Font.ColorIndex = 35   If Cells(cell.Row - 1, 5) <> 2 Then i = 0 If Cells(cell.Row, 5) = 2 Then i = i + 1 If i = 4 Then Cells(cell.Row, 5) = Cells(cell.Row - 4, 5) End If   Cells(cell.Row, 5).Font.ColorIndex = 0 Next cell End Sub

---

D'abord, Merci pour vos réponses rapides! :D

J'ai préparé un exemple avec les explications peut-être plus claires :)

1/ Parcourir le fichier jusqu’à arrivé à un "2" , si plusieurs "2" se suivent il faut compter le nombre de deux, et stocker ce résultat (variable X par exemple).
2/ Remplacer les lignes contenant ces "2" par les valeurs des cellules i - X
3/ remettre la valeur de X à zéro une fois tous les "2" remplacés et continuer la recherche jusqu'au prochain groupe de "2"...


Nouvelles de dernière minute : lorsque la dernière valeur avant un "2" est "PORT" il faut que cela re-décale d'un cran supplémentaire (compter le PORT comme un "2" peut-être?). :?

Ce qui est fait dans le code que je t'ai donné
(A quelque réglage prés). Le plus gros est fait, il suffit d'adapté.

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18

Sub devellopez() Dim cell As Range Dim i As Integer For Each cell In Range("e2:e" & Range("e65536").End(xlUp).Row) Cells(cell.Row, 5).Font.ColorIndex = 3 'cette ligne est pour le fun   If Cells(cell.Row - 1, 5) <> 2 And Cells(cell.Row - 1, 5) <> "PORT" Then i = 0 If Cells(cell.Row, 5) = 2 Or Cells(cell.Row, 5) = "PORT" Then i = i + 1 If i = 4 Then Cells(cell.Row, 5) = Cells(cell.Row - 4, 5) Cells(cell.Row - 1, 5) = Cells(cell.Row - 4, 5) Cells(cell.Row - 2, 5) = Cells(cell.Row - 4, 5) Cells(cell.Row - 3, 5) = Cells(cell.Row - 4, 5) End If   Cells(cell.Row, 5).Font.ColorIndex = 0 'cette ligne est pour le fun Next cell End Sub

---

Donc à peu prés cela

Merci, je n'avais pas vu ton message, désolé!

En fait le problème que j'ai rencontré avec un seul if, c'est que la macro parcours tout la tableau d'un coup et ne s’arrête pas au premier groupe de "2" pour en modifier les valeurs et passer au groupe suivant.

Je ne sais pas si le problème est le même mais t'as macro rencontre le même problème (lors du défilement pas à pas)


C'est pour ça que j'étais rapidement passé à une réflexion en deux boucles. Une pour compter les "2" et s'arrêter a la fin d'un groupe, et la deuxième pour parcourir ce groupe et en changer les valeurs. Je ne vois pas d'autre moyen que d'utiliser deux boucles...

La macro n' a aucun probleme, c'est juste qu'elle attend de voir un groupe de 4 deux avant d'effectuer le changement des valeurs. Etait ce bien ce que tu souhaitait ou t'es tu trompé dans l'énoncé du probleme.

Ne fallait-il pas remplacé tous les 2 de la colonne par la valeur de la premiere cellule superieure non egale à deux.

le plus simple est que tu mettes un exemple du résultat à obtenir car on ne pourra partager la peche que lorsque l'on connaitra le nombre de pecheurs.

Bonsoir,

Effectivement je me suis peut-être mal expliqué sur le résultat voulu.

La macro a un objectif, remplacer les "2" par des valeurs déjà présentent dans la colonne. Ces valeurs dépendent du nombre de "2" qui se suivent. S'il y a 4 "2" a la suite alors les données de chaque deux seront pris dans la cellule juste au dessus du premier "2" - 4. S'il y 8 "2" alors la macro prend les données de la 8eme cellule au dessus.

1 ère étape : parcourir le tableau jusqu’à un groupe de "2" --> compter le nombre de "2" et stocker cette valeur dans une variable "X".

2 ème étape : parcourir ce même groupe de "2" et changer les "2" par des valeurs i-X

Puis reprendre le parcours du tableau jusqu'au prochain groupe de "2"...



Après discussion, cette macro fonctionne, mais prend du temps et pourrait surement être améliorée.


Exemple en image (peut-être plus parlant)