Bonjour.

Voici mon problème, j'ai un dépassement de capacité lorsque je veux afficher une recherche dans un tableau. Je ne comprends pas pourquoi, et après avoir regardé sur plusieurs forums changer les integer en double ne change rien.

J'ai fait la recherche dans un tableau en suivant le tutoriel suivant, et en l'adaptant :


Et j'ai essayé d'optimiser mon code en suivant ce tutoriel ci :


Mais rien n'y fait, au bout d'une vingtaine de lignes a peu pres, le message "dépassement de capacité" apparait.
Il n'y a pourtant que 1000 lignes environ dans le tabeau où je recherche des mots.

Voici les fonctions utilisées :

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
Option Explicit
 
Sub Chercher()
Dim tab_mots() As String
Dim compteur As Byte
Dim ligne As Integer: Dim ligne_ext As Integer
Dim valider As Boolean
Dim nom As String: Dim cle As String
Dim redacteur As String: Dim valideur As String
Dim chaine As String
Dim i As Byte
 
Call TurnOffStuff
 
purger
 
tab_mots = Split(Range("C4").Value, " ")
 
ligne = 4: ligne_ext = 8
 
While Sheets("Suivi DOC").Cells(ligne, 1).Value <> ""
    valider = True
 
    nom = Sheets("Suivi DOC").Cells(ligne, 3).Value
    redacteur = Sheets("Suivi DOC").Cells(ligne, 7).Value
    valideur = Sheets("Suivi DOC").Cells(ligne, 8).Value
    cle = Sheets("Suivi DOC").Cells(ligne, 10).Value
 
    chaine = nom & "-" & redacteur & "-" & valideur & "-" & cle
 
    For compteur = 0 To UBound(tab_mots())
        If (InStr(1, sansAccent(chaine), sansAccent(tab_mots(compteur)), vbTextCompare) = 0) Then
            valider = False
            Exit For
        End If
 
    Next compteur
 
    If (valider = True) Then
        For i = 2 To 15
            Cells(ligne_ext, i).Value = Sheets("Suivi DOC").Cells(ligne, i - 1).Value
        Next i
 
        ligne_ext = ligne_ext + 1
    End If
 
    ligne = ligne + 1
Wend
Call TurnOnStuff
 
End Sub
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
 
Sub purger()
Dim ligne As Integer
Dim colonne As Byte
 
ligne = 8
 
While (Cells(ligne, 2).Value <> "")
    For colonne = 2 To 15
        Cells(ligne, colonne).Value = ""
    Next colonne
    ligne = ligne + 1
Wend
 
End Sub
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
 
Function sansAccent(chaine As String) As String
    Dim ch_avec As String
    Dim ch_sans As String
    Dim tampon As String
    Dim i As Byte
    Dim position As Byte
 
    ch_avec = "ÉÈÊËÔéèêëàçùôûïî"
    ch_sans = "EEEEOeeeeacuouii"
    tampon = chaine
 
    For i = 1 To Len(tampon)
        position = InStr(ch_avec, Mid(tampon, i, 1))
        If position > 0 Then
            Mid(tampon, i, 1) = Mid(ch_sans, position, 1)
        End If
    Next i
 
        sansAccent = tampon
End Function
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
 
Sub TurnOffStuff()
 
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
 
 
End Sub
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
 
Sub TurnOnStuff()
 
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
 
 
End Sub
Je ne vois vraiment pas comment résoudre ce problème.

Merci d'avance.