Fonction find... next sans fin !!

Fab2108

XLDnaute Nouveau
Bonjour,

Je viens de faire une sub pour règler mon problème de TCD qui plante régulièrement...(sujet qui date un peu).

Mon code fonctionne et je parviens a obtenir le même résultat qu'avec mon TCD.

Seul souci, la procédure ne s'arrête pas...

En fait, lorsque la plage de données a été balayée de haut en bas... il recommence depuis la première ligne...

Comme mes compétences plafonnent (liées a mon petit niveau) j'ai besoin d'un coup de main.

Voici le code :
Sub TABPAIEMENT()

Dim DLIGNE As Range

Dim fin As String

Dim Recherche As Range

Dim ligne As String

Dim NB As String

Dim FACT As String

Dim Montant As String

Dim test As String

ligne = 2

test = 0

With Sheets("PRODUCTION").Range("A:A")

Set DLIGNE = .Find(what:="", LookAt:=xlWhole, LookIn:=xlValues)

If Not DLIGNE Is Nothing Then

Else

GoTo fin

End If

fin = DLIGNE.Row

End With

Sheets("TABPAIEMENT").Range("A1:B100").Clear

Sheets("PRODUCTION").Select

Selection:

With Sheets("PRODUCTION").Range("O:O")

If test = 0 Then

Set Recherche = .Find(what:="A payer", LookAt:=xlWhole, LookIn:=xlValues, searchdirection:=xlNext)

If Not Recherche Is Nothing Then

Else

GoTo fin

End If

Else

Set Recherche = .FindNext(Recherche)

If Not Recherche Is Nothing Then

Else

GoTo fin

End If

End If

End With

With Sheets("PRODUCTION").Range("PROD")



If .Cells(Recherche.Row, 2) = "mon client" Then

FACT = .Cells(Recherche.Row, 5).Value

Montant = .Cells(Recherche.Row, 9).Value

test = test + 1

GoTo Tableau

Else

test = test + 1

GoTo Selection

End If

End With

Tableau:

With Sheets("TABPAIEMENT")

.Range("A1").Value = "Paiement Global"

.Cells(ligne, 1).Value = FACT

.Cells(ligne, 2).Value = Montant

ligne = ligne + 1

GoTo Selection


End With

fin:

end sub
 

Grand Chaman Excel

XLDnaute Impliqué
Re : Fonction find... next sans fin !!

Bonjour Fab2108,

Sans avoir de fichier pour tester, je crois que ton problème est causé par ton .FindNext qui tourne en rond.
Pour corriger le problème, tu dois garder en mémoire l'adresse de la 1re cellule trouvée et arrêter quand tu y reviens. (va voir l'aide sur .FindNext dans Excel et l'exemple)

J'ai mis dans le code 3 lignes à modifier / ajouter. Ces lignes sont identifiées avec des ****

À tester de ton côté.

VB:
Sub TABPAIEMENT()
 
Dim DLIGNE As Range
Dim fin As String
Dim Recherche As Range
Dim ligne As String
Dim NB As String
Dim FACT As String
Dim Montant As String
Dim test As String
Dim firstAddress As Range   '****
 
ligne = 2
test = 0
 
With Sheets("PRODUCTION").Range("A:A")
Set DLIGNE = .Find(what:="", LookAt:=xlWhole, LookIn:=xlValues)
If Not DLIGNE Is Nothing Then
Else
GoTo fin
End If
fin = DLIGNE.Row
End With
 
Sheets("TABPAIEMENT").Range("A1:B100").Clear
Sheets("PRODUCTION").Select
 
Selection:
 
With Sheets("PRODUCTION").Range("O:O")
    If test = 0 Then
        Set Recherche = .Find(what:="A payer", LookAt:=xlWhole, LookIn:=xlValues, searchdirection:=xlNext)
        If Not Recherche Is Nothing Then
            firstAddress = Recherche.Address    '***
        Else
            GoTo fin
        End If
    Else
        Set Recherche = .FindNext(Recherche)
        If Not Recherche Is Nothing And Recherche.Address <> firstAddress Then  '****
        Else
            GoTo fin
        End If
    End If
End With
 
With Sheets("PRODUCTION").Range("PROD")
    If .Cells(Recherche.Row, 2) = "mon client" Then
        FACT = .Cells(Recherche.Row, 5).Value
        Montant = .Cells(Recherche.Row, 9).Value
        test = test + 1
    GoTo Tableau
    Else
        test = test + 1
        GoTo Selection
    End If
End With
 
Tableau:
With Sheets("TABPAIEMENT")
    .Range("A1").Value = "Paiement Global"
    .Cells(ligne, 1).Value = FACT
    .Cells(ligne, 2).Value = Montant
    ligne = ligne + 1
    GoTo Selection
End With
fin:
 
End Sub

A+
 

Fab2108

XLDnaute Nouveau
Re : Fonction find... next sans fin !!

Bonjour Grand Chaman Excel,

Je te remercie de ton aide.

J'ai modifié mon code et.... ça plante sur la ligne : firstAddress = Recherche.Address

Erreur variable ou bloc with non défini.

J'ai beau triturer le code je vois pas où....

Merci d'avance
 

Gelinotte

XLDnaute Accro
Re : Fonction find... next sans fin !!

Bonjour,

Ce genre d'erreur provient d'une erreur d'écriture.
Un With va avec un End With
Un IF va avec un End IF
Etc.

Soit qu'il manque une fin. Soit qu'il y a imbrication non logique du genre :
With blabla
if blabla
...
End With
End if

Ceci va donner une erreur semblable. Le End If doit aller devant le End With et non derrière.

G
 

Discussions similaires

Haut Bas