Recherche code complet foncfion find lookat:=xlWhole

Le 10/10/2016 à 11:11

Bonjour tout le monde.

Je recherche à faire fonctionné la fonction find avec la fonction lookat:=xlWhole, pour que mon programme recherche le code complet et pas une partie de ce code. Exemple mon code est a2-2015-220 ma macro sarrette quand elle trouve le code a2-2015-22, cela fausse tous les résultats. Je voudrais donc utiliser une fonction permettant de recherche le code complet avec mes fonctions find ci dessous

Sub Relance()
Dim feuil As Workbook
Dim chaine As String

Dim limite As Integer

Dim semaine As String

Dim trouve As Range
Dim total As Range
Dim nb_feuil As Integer

Dim nb As Integer

Dim Relance As Worksheet
Dim dos_gestion As Worksheet
Dim dos_complet As Worksheet
'Dim doc_gest As Worksheet
Dim dos_recu As Worksheet
'Dim graph As Worksheet
Dim tot_sem As Worksheet
Dim sem As Worksheet

Dim ligd As Long
Dim cold As Long
Dim ligf As Integer
Dim colf As Long

Set feuil = ThisWorkbook
feuil.Activate
Set Relance = feuil.Worksheets("Relance")
'Set doc_gest = feuil.Worksheets("Documents gestion")
Set dos_gestion = feuil.Worksheets("Dossiers gestion")
Set dos_complet = feuil.Worksheets("Dossiers complets")
Set dos_recu = feuil.Worksheets("Dossiers recus + en stock")
'Set graph = feuil.Worksheets("Graphique")
Set tot_sem = feuil.Worksheets("Total par Semaine et ETP")
semaine = "Semaine "
feuil.Activate
Relance.Select

limite = 2000
ligd = 4
cold = 1
nb_feuil = feuil.Worksheets.Count
chaine = "Total"

nb = nb_feuil
'------------------- je recherche dans la colonne A de relance---------
Application.DisplayAlerts = False

While ligd <= limite   'recherche de la ligne 4 à la ligne 2000 de la feuille de relance
    Relance.Cells(ligd, cold).Select
    If Relance.Cells(ligd, cold).Value = 0 Or Relance.Cells(ligd, cold).Value = "" Then
        ligd = ligd + 1
    Else
        If Relance.Cells(ligd, cold + 1).Value <> "" Then
            ligd = ligd + 1
        Else
            Set trouve = dos_complet.Range("B1:B500").Find(Relance.Cells(ligd, cold).Value)
            If trouve Is Nothing Then
                Set trouve = dos_gestion.Range("B1:B100").Find(Relance.Cells(ligd, cold).Value)
                If trouve Is Nothing Then
                    Do While nb >= 9 'recherche par feuille semaine à partir de la dernière feuille jusqu'à la feuille de la première semaine
                        Set sem = feuil.Worksheets(nb)
                        Set trouve = sem.Range("B1:BJ2000").Find(Relance.Cells(ligd, cold).Value)
                        If trouve Is Nothing Then
                            nb = nb - 1
                        Else
                            ligf = trouve.Row
                            colf = trouve.Column
                            While Not sem.Cells(ligf, colf).Value Like "Total*" And ligf > 21
                                ligf = ligf - 1
                            Wend
                            If ligf = 22 Then
                                Relance.Cells(ligd, cold + 5) = sem.Name
                                Relance.Cells(ligd, cold + 6) = " Attention Total non trouvé"
                                ligd = ligd + 1
                            Else
                                Relance.Cells(ligd, cold + 5) = sem.Name
                                Relance.Cells(ligd, cold + 6) = sem.Cells(ligf, colf).Text
                                ligd = ligd + 1
                            End If
                            nb = nb_feuil
                            Exit Do
                        End If
                        If nb < 9 Then
                            Relance.Cells(ligd, cold + 4) = "Non trouvé"
                             Relance.Cells(ligd, cold + 3) = "Non trouvé"
                             Relance.Cells(ligd, cold + 5) = "Non trouvé"
                            Relance.Cells(ligd, cold + 6) = "Non trouvé"
                            ligd = ligd + 1
                        End If
                    Loop

                Else
                    Relance.Cells(ligd, cold + 4) = "Dossiers gestion " & dos_gestion.Cells(trouve.Row, trouve.Column + 2).Value
                    ligd = ligd + 1
                End If
            Else
                Relance.Cells(ligd, cold + 3) = "Dossiers complets " & dos_complet.Cells(trouve.Row, trouve.Column + 2).Value
                ligd = ligd + 1
            End If
        End If
    End If
Wend

End Sub
Le 10/10/2016 à 14:05

Bonjour

Essaie ainsi ;

Set trouve = dos_complet.Range("B1:B500").Find(Relance.Cells(ligd, cold).Value, LookAt:=xlWhole)

Bye !

Le 10/10/2016 à 14:57

Merci pour ta réponse GMB

mais j'obtiens une erreur de compilation et erreur de syntaxe,

Quelqu'un à une autre idée ?

Le 10/10/2016 à 16:51

Alors, joins ton fichier, on fera des tests...

Bye !

Le 12/10/2016 à 14:12

ci-joint une extraction de mon fichier excel,

35test-vba-forum.xlsx (417.63 Ko)

avec le code, si vous avez la moindre question n hésiter pas, merci d'avance

Sub Relance()
Dim feuil As Workbook
Dim chaine As String

Dim limite As Integer

Dim semaine As String

Dim trouve As Range
Dim total As Range
Dim nb_feuil As Integer

Dim nb As Integer

Dim Relance As Worksheet
Dim dos_gestion As Worksheet
Dim dos_complet As Worksheet
'Dim doc_gest As Worksheet
Dim dos_recu As Worksheet
'Dim graph As Worksheet
Dim tot_sem As Worksheet
Dim sem As Worksheet

Dim ligd As Long
Dim cold As Long
Dim ligf As Integer
Dim colf As Long

Set feuil = ThisWorkbook
feuil.Activate
Set Relance = feuil.Worksheets("Relance")
'Set doc_gest = feuil.Worksheets("Documents gestion")
Set dos_gestion = feuil.Worksheets("Dossiers gestion")
Set dos_complet = feuil.Worksheets("Dossiers complets")
Set dos_recu = feuil.Worksheets("Dossiers recus + en stock")
'Set graph = feuil.Worksheets("Graphique")
Set tot_sem = feuil.Worksheets("Total par Semaine et ETP")
semaine = "Semaine "
feuil.Activate
Relance.Select

limite = 2000
ligd = 4
cold = 1
nb_feuil = feuil.Worksheets.Count
chaine = "Total"

nb = nb_feuil
'------------------- je recherche dans la colonne A de relance---------
Application.DisplayAlerts = False

While ligd <= limite   'recherche de la ligne 4 à la ligne 2000 de la feuille de relance
   Relance.Cells(ligd, cold).Select
    If Relance.Cells(ligd, cold).Value = 0 Or Relance.Cells(ligd, cold).Value = "" Then
        ligd = ligd + 1
    Else
        If Relance.Cells(ligd, cold + 1).Value <> "" Then
            ligd = ligd + 1
        Else
            Set trouve = dos_complet.Range("B1:B500").Find(Relance.Cells(ligd, cold).Value)
            If trouve Is Nothing Then
                Set trouve = dos_gestion.Range("B1:B100").Find(Relance.Cells(ligd, cold).Value)
                If trouve Is Nothing Then
                    Do While nb >= 9 'recherche par feuille semaine à partir de la dernière feuille jusqu'à la feuille de la première semaine
                       Set sem = feuil.Worksheets(nb)
                        Set trouve = sem.Range("B1:BJ2000").Find(Relance.Cells(ligd, cold).Value)
                        If trouve Is Nothing Then
                            nb = nb - 1
                        Else
                            ligf = trouve.Row
                            colf = trouve.Column
                            While Not sem.Cells(ligf, colf).Value Like "Total*" And ligf > 21
                                ligf = ligf - 1
                            Wend
                            If ligf = 22 Then
                                Relance.Cells(ligd, cold + 5) = sem.Name
                                Relance.Cells(ligd, cold + 6) = " Attention Total non trouvé"
                                ligd = ligd + 1
                            Else
                                Relance.Cells(ligd, cold + 5) = sem.Name
                                Relance.Cells(ligd, cold + 6) = sem.Cells(ligf, colf).Text
                                ligd = ligd + 1
                            End If
                            nb = nb_feuil
                            Exit Do
                        End If
                        If nb < 4 Then
                            Relance.Cells(ligd, cold + 4) = "Non trouvé"
                             Relance.Cells(ligd, cold + 3) = "Non trouvé"
                             Relance.Cells(ligd, cold + 5) = "Non trouvé"
                            Relance.Cells(ligd, cold + 6) = "Non trouvé"
                            ligd = ligd + 1
                        End If
                    Loop

                Else
                    Relance.Cells(ligd, cold + 4) = "Dossiers gestion " & dos_gestion.Cells(trouve.Row, trouve.Column + 2).Value
                    ligd = ligd + 1
                End If
            Else
                Relance.Cells(ligd, cold + 3) = "Dossiers complets " & dos_complet.Cells(trouve.Row, trouve.Column + 2).Value
                ligd = ligd + 1
            End If
        End If
    End If
Wend

End Sub
Le 12/10/2016 à 15:26

Avec un dossier incomplet et sans macros, je ne peux pas faire grand chose.

Délolé ...

Bye !

Rechercher des sujets similaires à "recherche code complet foncfion find lookat xlwhole"