Problème de recherche dans macro avec .find

**steelk** · 17/10/2014, 18h21

Bonjour,

Je vous joint le fichier pour plus de simplicité.

La macro permet de rapatrier dans la colonne E de la feuille 2014-08 les catégories de la feuille cat.
La recherche est basée avec les mots clés identifies en colonne B (feuille 2014-08).

Les problèmes sont:
- Certaines valeur en doubles ne sont pas trouvées
- Certain mots clés ne sont pas détectés...

Merci de votre aide!

**Philippe Tulliez** · 17/10/2014, 18h35

Bonjour,

Je vous joint le fichier pour plus de simplicité.

Simplicité pour qui ?
Je pense que tu aurais plus de chances d'avoir une réponse en expliquant comment sont organisées tes données et en publiant la procédure qui pose problème.

**Kimy_Ire** · 17/10/2014, 18h45

Bonjour steelk,

Alors, d'après ce que je comprends de ton problème, tu utilises la méthode "find" alors que plusieurs cellule sont susceptibles de contenir la valeur cherchée.

Pour ma part, j'ai trouvé ceci sur le net que j'ai utilisé à de nombreuses reprises.

Source : http://www.cpearson.com/excel/findall.aspx
(Il y a plein d'autres endroits sur le net avec la même fonction.)

Je te la place ici :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
Function FindAll(SearchRange As Range, _
                FindWhat As Variant, _
               Optional LookIn As XlFindLookIn = xlValues, _
                Optional LookAt As XlLookAt = xlWhole, _
                Optional SearchOrder As XlSearchOrder = xlByRows, _
                Optional MatchCase As Boolean = False, _
                Optional BeginsWith As String = vbNullString, _
                Optional EndsWith As String = vbNullString, _
                Optional BeginEndCompare As VbCompareMethod = vbTextCompare) As Range
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' FindAll
' This searches the range specified by SearchRange and returns a Range object
' that contains all the cells in which FindWhat was found. The search parameters to
' this function have the same meaning and effect as they do with the
' Range.Find method. If the value was not found, the function return Nothing. If
' BeginsWith is not an empty string, only those cells that begin with BeginWith
' are included in the result. If EndsWith is not an empty string, only those cells
' that end with EndsWith are included in the result. Note that if a cell contains
' a single word that matches either BeginsWith or EndsWith, it is included in the
' result.  If BeginsWith or EndsWith is not an empty string, the LookAt parameter
' is automatically changed to xlPart. The tests for BeginsWith and EndsWith may be
' case-sensitive by setting BeginEndCompare to vbBinaryCompare. For case-insensitive
' comparisons, set BeginEndCompare to vbTextCompare. If this parameter is omitted,
' it defaults to vbTextCompare. The comparisons for BeginsWith and EndsWith are
' in an OR relationship. That is, if both BeginsWith and EndsWith are provided,
' a match if found if the text begins with BeginsWith OR the text ends with EndsWith.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
Dim FoundCell As Range
Dim FirstFound As Range
Dim LastCell As Range
Dim ResultRange As Range
Dim XLookAt As XlLookAt
Dim Include As Boolean
Dim CompMode As VbCompareMethod
Dim Area As Range
Dim MaxRow As Long
Dim MaxCol As Long
Dim BeginB As Boolean
Dim EndB As Boolean
 
 
CompMode = BeginEndCompare
If BeginsWith <> vbNullString Or EndsWith <> vbNullString Then
    XLookAt = xlPart
Else
    XLookAt = LookAt
End If
 
' this loop in Areas is to find the last cell
' of all the areas. That is, the cell whose row
' and column are greater than or equal to any cell
' in any Area.
 
For Each Area In SearchRange.Areas
    With Area
        If .Cells(.Cells.Count).Row > MaxRow Then
            MaxRow = .Cells(.Cells.Count).Row
        End If
        If .Cells(.Cells.Count).Column > MaxCol Then
            MaxCol = .Cells(.Cells.Count).Column
        End If
    End With
Next Area
Set LastCell = SearchRange.Worksheet.Cells(MaxRow, MaxCol)
 
On Error GoTo 0
Set FoundCell = SearchRange.Find(what:=FindWhat, _
        after:=LastCell, _
        LookIn:=LookIn, _
        LookAt:=XLookAt, _
        SearchOrder:=SearchOrder, _
        MatchCase:=MatchCase)
 
If Not FoundCell Is Nothing Then
    Set FirstFound = FoundCell
    Do Until False ' Loop forever. We'll "Exit Do" when necessary.
        Include = False
        If BeginsWith = vbNullString And EndsWith = vbNullString Then
            Include = True
        Else
            If BeginsWith <> vbNullString Then
                If StrComp(Left(FoundCell.Text, Len(BeginsWith)), BeginsWith, BeginEndCompare) = 0 Then
                    Include = True
                End If
            End If
            If EndsWith <> vbNullString Then
                If StrComp(Right(FoundCell.Text, Len(EndsWith)), EndsWith, BeginEndCompare) = 0 Then
                    Include = True
                End If
            End If
        End If
        If Include = True Then
            If ResultRange Is Nothing Then
                Set ResultRange = FoundCell
            Else
                Set ResultRange = Application.Union(ResultRange, FoundCell)
            End If
        End If
        Set FoundCell = SearchRange.FindNext(after:=FoundCell)
        If (FoundCell Is Nothing) Then
            Exit Do
        End If
        If (FoundCell.Address = FirstFound.Address) Then
            Exit Do
        End If
 
    Loop
End If
 
Set FindAll = ResultRange
 
End Function

Elle est, bien entendu, à adapter mais fonctionne bien !

J'espère qu'elle pourra te servir.

Cordialement,
Kimy

**Thautheme** · 17/10/2014, 19h00

Bonsoir Steelk, bonsoir le forum,

Quel code étrange ! Essaie d'y adapter le code ci-dessous :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Public Sub Macro1()
Dim C As Object 'déclare la varoable C (onglet Cat)
Dim O As Object 'déclare la varoable O (onglet)
Dim DL As Integer 'déclare la varoable DL (Dernière ligne)
Dim PL As Range 'déclare la varoable PL (PLage)
Dim CEL As Range 'déclare la varoable CEL (CELlule)
Dim R As Range 'déclare la varoable R (Recherche)
 
Set C = Sheets("Cat") 'définit l'onglet C
Set O = Sheets("2014-08") 'définit l'onglet O
DL = O.Cells(Application.Rows.Count, 2).End(xlUp).Row 'définit la dernière ligne éditée Dl de la colonne 2 (=B) de l'onglet O
Set PL = O.Range("B2:B" & DL) 'définit la plage PL
For Each CEL In PL 'boucle sur toutes les cellules CEl de la palge PL
    'définit la recherche R (recherche dans la plage B3:D33 de l'onglet C la valeur de la cellules CEL (sans les éventuels espaces en trop)
    Set R = C.Range("B3:D33").Find(Trim(CEL.Value), , xlValues, xlPart)
    If Not R Is Nothing Then 'condition : si au moins une occurrence est trouvée
        CEL.Offset(0, 3).Value = C.Cells(2, R.Column) 'récupère la valeur correspondante en ligne 2 de l'onglet C
    Else 'sinon
        CEL.Offset(0, 3).Value = "FAUX" 'écrit "FAUX"
    End If 'fin de la condition
Next CEL 'prochaine cellule de la boucle
End Sub

[Édition]
Bonsoir Philippe, Kimy, on s'est croisé...

**Marc-L** · 17/10/2014, 19h39

J'en suis resté à sa précédente discussion de la veille auquel il n'a daigné répondre à aucune des propositions …

**steelk** · 20/10/2014, 17h15

Bonjour à tous,

Désolé pour ma réponse tardive tout d'abords suite à ce WE non connecté pour moi et merci de vos messages.

@Thautheme:

Quel code étrange !

désolé mais effectivement je pense que mon code est loin d'etre parfait mais parfois on fait avec les moyens du bord....Désolé
Sinon, j'ai essayé d'adapter ton code avec ce que tu as posté et fonctionne pas mal mais pas dans tous mes cas. Il est vrai que ma demande n'était peut etre pas claire.

Je m'explique, les cellules de la feuille "catégorie" et de la colonne B de la feuille "2014-08" contiennent des chaines de caratères et non seulement des mots seul (comme dans le fichier d'exemple).
Exemple: dans catégories je peut avoir "impression texte" mais si dans la colonne B de "2014-08" j'ai "impresssion" il faut retourner faux. Si cependant j'ai "impression texte toto" il faut retourner divers car "impression texte" a été trouvé...

J'espere avoir été un peu plus clair.

Steelk

**Thautheme** · 20/10/2014, 21h45

Bonsoir le fil, bonsoir le forum,

@Steelk : le code est étrange pour moi qui n'ai pas un niveau très élevé mais loin de moi l'idée de le dénigrer... Malheureusement je suis loin d'avoir le niveau pour entreprendre autre chose que ce que je t'ai proposé. As-tu essayer la proposition de Kimy ?