fonction instr à choix multiples, plusieurs valeurs recherchées possibles.

[Dennis Nedry]

Bonjour.

Je suis en train de m'acharner à chercher un résultat alors que la solution doit fort probablement se trouver au bout de mon nez...

J'ai 2 feuilles au sein d'un même classeur: dans l'une se trouve une série de chaines de caractères assez longue, tandis que dans l'autre feuille se trouve une autre série de chaines de caractères, bien plus courtes.

Je recherche l'existence de n'importe laquelle des courtes chaines de caractères au sein de la grande chaine.

Par exemple, feuille 1:

Lucas Rabine
Marc Tapage
René Sens

Feuille 2 (appelée database):

ené
luc
martin
per
nod

Dans ce cas, Lucas Rabine (luc) et René Sens (ené) seront sélectionnés.

J'ai fait le code suivant, qui fonctionne, mais au vu de la quantité astronomique d'enregistrements, il apparait difficile d'utiliser cette méthode... j'ai 20,000 lignes à analyser, avec pour chacune plus de 11,000 possibilités.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub recherche()
Dim i As Integer
Dim rech As Integer
Dim fullname As String
 
For i = 1 To 21000
fullname = LCase(Cells(i, 2))
rech = 1
For rech = 1 To 11142
    If InStr(fullname, Sheets("database").Cells(rech, 1)) > 0 Then
        Cells(i, 4) = "oui: " & Sheets("database").Cells(rech, 1)
        rech = 11142
    End If
Next rech
 
Next i
 
End Sub

Dans le cas présenté, il analyse 2 lignes par seconde... je vous laisse imaginer le temps nécessaire pour les 20,000 lignes. Y a-t-il une fonction plus rapide, et plus évidente pour y arriver? InStr n'analyse qu'un string à la fois, alors qu'il faudrait qu'il en analyse plus de 11,000 par ligne...

[jfontaine]

Bonjour,

Je sais pas si ce sera plus rapide, mais regarde l'instruction FIND qui te permettra de connaitre les cellules contenant la chaine de caractère recherchée

[gFZT82]

Bonjour,

Tu dois pouvoir gagner une bonne poignée de secondes en utilisant des tableaux de traitements intermédiaires.

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
Sub recherche()
Dim i As Integer
Dim rech As Integer
Dim fullname As String
Dim tablo1 As Variant
Dim tablo2 As Variant
 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
 
tablo1 = Range("B1:B21000")
tablo2 = Worksheets("database").Range("A1:A11142")
 
For i = 1 To 21000
    fullname = LCase(tablo1(i, 1))
    For rech = 1 To 11142
        If InStr(fullname, tablo2(rech, 1)) > 0 Then
            Cells(i, 4) = "oui: " & Sheets("database").Cells(rech, 1)
            Exit For
        End If
    Next rech
Next i
 
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
 
End Sub

Cordialement.