[Résolu par Pierre-Jean] Pb boucle avec Findnext (ie:retrouve, copie et faire une différence)

[zebanx]

Bonjour à tous,

Le code ci-après traite une recherche de type "FIND" avec copie en offset et calcul d'une différence.
Il vient rechercher une valeur "perf.KE" et fait son travail à partir de cette valeur retrouvée.
Le code fonctionne en boucle "1" mais je n'arrive pas à boucler pour les autres occurrences retrouvées en .findnext sachant que les tableaux ne sont pas standards (mais tous finissent au maximum sur la colonne 7) et qu'on ne peut pas utiliser un STEP.

Je vous remercie pour votre aide.
Bonne journée
zebanx.

Finalité : Pour une comparaison après mise à jour de TCD. Les valeurs sont extraites avant une autre macro qui vient faire un reset du tableau de base (Le nombre de lignes restant inchangé).

-----------------------
Code :
Sub faire()
Dim cel As Range
Dim derligne As Integer, firstcol, celcol, celrow
Dim FirstAdress As String

On Error Resume Next

With Worksheets(1).Range("a1:e500")

Set cel = Cells.Find(What:="perf.KE", LookAt:=xlWhole)
celcol = cel.Column
celrow = cel.Row
derligne = Cells(celrow, celcol).End(xlDown).Row
firstcol = Cells(celrow, celcol).End(xlToLeft).Column

If Not cel Is Nothing Then
FirstAddress = cel.Address

Do
Range(Cells(celrow, celcol), Cells(derligne, celcol)).Copy
Range(Cells(celrow, celcol), Cells(derligne, celcol)).Offset(0, 6).PasteSpecial Paste:=xlValues
Range(Cells(celrow + 1, celcol), Cells(derligne, celcol)).Offset(0, 7).FormulaR1C1 = "=+RC[-1]-RC[-7]"

Set cel = .FindNext(cel)
Loop While Not cel Is Nothing And cel.Address <> FirstAddress

End If
End With
End Sub

 

[pierrejean]

Bonjour zebanx

Vois si cela te convient

 

[job75]

Bonjour zebanx, Pierre,

Je n'ai pas étudié le problème mais ceci me saute aux yeux : While Not cel Is Nothing And cel.Address

En effet si cel Is Nothing => cel.Address crée forcément un bug...

A+

 

[zebanx]

Bonjour Pierre-Jean,

Content de vous revoir sur un post émis

Cela fonctionne très bien, avec des lignes de codes toujours intéressantes et qui me sont peu familières comme :
- tablo(UBound(tablo)) = cel.Address
- Range(tablo(n)).Offset(, 6) = "perf.KE"

Je vous remercie de vous être penché sur ce code et vous souhaite une bonne soirée.
thierry



ps : une ligne rajoutée sur le code pour avoir les différences à partir de vos références = terminé !
......
For n = cel.Row To cel.End(xlDown).Row
Cells(n + 1, cel.Column + 6) = cel.Offset(nb)
nb = nb + 1
Range(Cells(cel.Row + 1, cel.Column), Cells(cel.End(xlDown).Row, cel.Column)).Offset(0, 7).FormulaR1C1 = "=+RC[-1]-RC[-7]"
Next
Set cel = ActiveSheet.Cells.FindNext(cel)
.....

 

[zebanx]

@job75
Bonjour,

Merci pour ton retour.

Je suis parti de codes retrouvés ici et là, notamment sur un sujet résolu par Gosselien et qui fonctionnait bien (mais que je n'ai pas su adapter).

La formule me semble toutefois correcte dans sa rédaction et en la collant dans un moteur de recherche on arrive à une formule à regarder aussi.*
Ce lien n'existe plus
(mais s'il n'y a pas d'équivalence retrouvée, il faut sortir de la boucle = ok )

Bonne soirée.
thierry

* Je vais reprendre le pas à pas détaillé pour voir si je peux faire quelque chose de ce premier code (parce que fonctionnant sur le premier tableau) avec cette proposition de code, la réponse adaptée de Pierre-Jean ne m'empêchant pas de continuer à chercher de mon côté !

Edit :
Un changement de positionnement de certaines lignes dans le code a permis de répondre à la solution avec la première version (en bleu). C'est pour info", le code de Pierre-Jean fonctionne parfaitement.

Sub copy_findnext()
Dim cel As Range
Dim derligne As Integer, firstcol, celcol, celrow
Dim FirstAdress As String

On Error Resume Next

With Worksheets("5.findnext").Range("a1:e500")

Set cel = Cells.Find(What:="perf.KE", LookAt:=xlWhole)

If Not cel Is Nothing Then
firstAddress = cel.Address

Do
celcol = cel.Column
celrow = cel.Row
derligne = Cells(celrow, celcol).End(xlDown).Row
firstcol = Cells(celrow, celcol).End(xlToLeft).Column

Range(Cells(celrow, celcol), Cells(derligne, celcol)).Copy
Range(Cells(celrow, celcol), Cells(derligne, celcol)).Offset(0, 6).PasteSpecial Paste:=xlValues
Range(Cells(celrow + 1, celcol), Cells(derligne, celcol)).Offset(0, 7).FormulaR1C1 = "=+RC[-1]-RC[-7]"

Set cel = .FindNext(cel)
Loop While Not cel Is Nothing And cel.Address <> firstAddress

End If
End With
End Sub