Macro VBA dépassement de capacité

Salut,

Après avoir cherché un ptit moment et testé plusieurs truc, je n'arrive pas à régler le soucis de dépassement de capacité dans mon programme, le voici:

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 orga As String
Dim chaine As String

purger
tab_mots = Split(Range("C4").Value, " ")

ligne = 3: ligne_ext = 7

While Sheets("Importation").Cells(ligne, 2).Value <> " "
valider = True

nom = Sheets("Importation").Cells(ligne, 2).Value
orga = Sheets("Importation").Cells(ligne, 3).Value

chaine = nom & "-" & orga

For compteur = 0 To UBound(tab_mots())

If (Len(tab_mots(compteur)) > 3) Then
If (InStr(1, sansAccent(chaine), sansAccent(tab_mots(compteur)), vbTextCompare) = 0) Then
valider = False
Exit For
End If
End If

Next compteur

If (valider = True) Then
Cells(ligne_ext, 2).Value = nom
Cells(ligne_ext, 3).Value = orga
Cells(ligne_ext, 4).Value = Sheets("Importation").Cells(ligne, 4).Value
Cells(ligne_ext, 5).Value = Sheets("Importation").Cells(ligne, 5).Value

ligne_ext = ligne_ext + 1

End If

ligne = ligne + 1
Wend

Cells(1, 1).Select

End Sub

Sub purger()
Dim ligne As Integer: Dim colonne As Byte

ligne = 7

While (Cells(ligne, 2).Value <> "")
For colonne = 2 To 5
Cells(ligne, colonne).Value = ""
Next colonne
ligne = ligne + 1
Wend

End Sub

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 String

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)
Next

sansAccent = tampon

End Function

Edit : Merci de mettre le code entre balises avec le bouton </>

Bonjour AgentDI et

Une petite présentation ICI serait la bienvenue

Sinon, commencez par définir vos variables pour les lignes en Long

Dim ligne As Long, Ligne_Ext As Long

@+

j'ai malheureusement déjà essayé ca et ca n'a pas fonctionné

Re,

Le débogage s'arrête sur quelle ligne ?

Sinon, merci de joindre un fichier sans donnée personnelle

@+

Ca me dit expression espionne sélectionnée incorrecte

Hein !?

Vous n'avez rien à faire dans VBA project, juste à lancer votre code et ensuite débogage au moment de la fenêtre

@+

Bonjour,

ta boucle while vérifie si une cellule =" ", or il n'y a aucune cellule en colonne B qui contient un espace. la macro continuera de s'exécuter jusqu'à une erreur de capacité que ce soit pour Integer ou Long ou limite du nombre de lignes d'excel.

voici une proposition de correction

Sub Chercher()
    Dim tab_mots() As String
    Dim compteur As Byte
    Dim ligne As Long: Dim Ligne_Ext As Long
    Dim valider As Boolean
    Dim nom As String: Dim orga As String
    Dim chaine As String

    purger
    tab_mots = Split(sansAccent(Range("C4").Value), " ")

    ligne = 3: Ligne_Ext = 7

    Do While Sheets("Importation").Cells(ligne, 2).Value <> ""
        valider = True

        nom = Sheets("Importation").Cells(ligne, 2).Value
        orga = Sheets("Importation").Cells(ligne, 3).Value

        chaine = sansAccent(nom & "-" & orga)

        For compteur = 0 To UBound(tab_mots())

            If (Len(tab_mots(compteur)) > 3) Then
                If (InStr(1, chaine, tab_mots(compteur), vbTextCompare) = 0) Then
                    valider = False
                    Exit For
                End If
            End If

        Next compteur

        If (valider = True) Then
            Cells(Ligne_Ext, 2).Value = nom
            Cells(Ligne_Ext, 3).Value = orga
            Cells(Ligne_Ext, 4).Value = Sheets("Importation").Cells(ligne, 4).Value
            Cells(Ligne_Ext, 5).Value = Sheets("Importation").Cells(ligne, 5).Value

            Ligne_Ext = Ligne_Ext + 1

        End If

        ligne = ligne + 1
    Loop

    Cells(1, 1).Select

End Sub

Merci, il n'y a plus de probleme de capacité mais maintenant le moteur de recherche ne fonctionne plus, il n'affiche pas les résultats par recherche mais tout.

Admettons que je cherche juste les RSA, il me ressort aussi l' APL

Bonjour,

dans ton code, si tu as un mot qui fait moins de 4 caractères, tu ne vérifies pas s'il faut exclure la ligne.

 If (Len(tab_mots(compteur)) > 3) Then

un proposition de correction

Sub Chercher()
    Dim tab_mots() As String
    Dim compteur As Byte
    Dim ligne As Long: Dim Ligne_Ext As Long
    Dim valider As Boolean
    Dim nom As String: Dim orga As String
    Dim chaine As String

    purger
    tab_mots = Split(sansAccent(Range("C4").Value), " ")

    ligne = 3: Ligne_Ext = 7

    Do While Sheets("Importation").Cells(ligne, 2).Value <> ""
        valider = False

        nom = Sheets("Importation").Cells(ligne, 2).Value
        orga = Sheets("Importation").Cells(ligne, 3).Value

        chaine = sansAccent(nom & "-" & orga)

        For compteur = 0 To UBound(tab_mots())

            If tab_mots(compteur) <> "" Then
                If (InStr(1, chaine, tab_mots(compteur), vbTextCompare) > 0) Then
                    valider = True
                    Exit For
                End If
            End If

        Next compteur

        If (valider = True) Then
            Cells(Ligne_Ext, 2).Value = nom
            Cells(Ligne_Ext, 3).Value = orga
            Cells(Ligne_Ext, 4).Value = Sheets("Importation").Cells(ligne, 4).Value
            Cells(Ligne_Ext, 5).Value = Sheets("Importation").Cells(ligne, 5).Value

            Ligne_Ext = Ligne_Ext + 1

        End If

        ligne = ligne + 1
    Loop

    Cells(1, 1).Select

End Sub