Programme VBA

Je regarde à ça de plus près.

Pour infos :

• -> La comparaison ne tient normalement pas compte de la casse (minuscules, majuscules) mais est sensible aux accents. Le code peut-être modifié pour supprimer au préalable les accents de la chaîne de caractères pour faciliter le recherche.
• -> Tu peux regarder ce que fais la macro en ouvrant VBA (Alt + F11) puis en faisant une exécution pas à pas (F8). En passant la souris sur les différentes variables, tu peux voir quelle valeur y est affectée.

Bon, j'ai trouvé le problème je crois...

La recherche avec la fonction Find() ne cherchais pas à retrouver les mots identiques, mais les suites de caractères contenues dans un mot de ta liste. Par exemple, dans la première adresse, il trouve une correspondance en "BAT" et "BATAILLER". J'ai donc précisé de chercher tout le mot et pas juste une partie (je pensais que c'était l'option par défaut).

Les autres erreurs proviennent d'ambiguïtés dans ta liste :

• -> Adresse 3 : "cap" = zone 5, "pramousquier" = zone 6
• -> Adresse 4 : "commandos" = zone ,1 "d'Afrique" = zone 2
• -> Adresse 5 : "Dauphins" = zone 4, "Auriol" = zone 1

Autre précision : peu importe le nombre de mots valides de ton adresse, si ils concernent tous la même zone, tu n'auras qu'une fois la valeur "1" dans ta ligne.

Voilà donc le code révisé :

Function SupprimerAccents(ByVal sChaine As String) As String

    Dim sTmp As String, i As Long, p As Long
    Const sCarAccent As String = "ÁÂÃÄÅÇÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïñòóôõöùúûüýÿ"
    Const sCarSansAccent As String = "AAAAACEEEEIIIINOOOOOUUUUYaaaaaaceeeeiiiinooooouuuuyy"

    sTmp = sChaine
    For i = 1 To Len(sTmp)
        p = InStr(sCarAccent, Mid(sTmp, i, 1))
        If p > 0 Then Mid$(sTmp, i, 1) = Mid$(sCarSansAccent, p, 1)
    Next i
    SupprimerAccents = sTmp

End Function
Sub AffecterZone()

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Dim Tableau() As String
    Dim i As Integer, Lig As Integer, Lmax As Integer
    Dim PLinvalid As Range, PLvalid As Range

    With Sheets("Table 1")
        Lmax = .Range("A" & Rows.Count).End(xlUp).Row 'Identifie la dernière ligne de la base de données
        Set PLinvalid = Sheets("Zone").Range("A2:A" & Sheets("Zone").Range("A" & Rows.Count).End(xlUp).Row)
        Set PLvalid = Sheets("Zone").Range("B2:B" & Sheets("Zone").Range("B" & Rows.Count).End(xlUp).Row)
        'boucle pour parcourir les lignes
        For Lig = 2 To Lmax
            'découpe l'adresse à partir des espaces
            Tableau = Split(SupprimerAccents(.Cells(Lig, 5)), " ")
            'boucle sur le tableau pour étudier chaque mot
             For i = 0 To UBound(Tableau)
                'On en travaille pas sur les mots génériques
                If PLinvalid.Find(Tableau(i), LookAt:=xlWhole) Is Nothing Or Not Right(Tableau(i), 1) Like "#" Then
                    'Si le mot est contenu dans la liste, donne le n° de zone correspondant
                    If Not PLvalid.Find(Tableau(i), LookAt:=xlWhole) Is Nothing Then
                        Zone = Sheets("Zone").Cells(PLvalid.Find(Tableau(i)).Row, 3)
                        If Not Zone = 0 Then .Cells(Lig, 5 + Zone) = 1 Else MsgBox "Zone non reconnue en cellule F" & PLvalid.Find(Tableau(i)).Row
                    End If
                End If
             Next i
        Next Lig
    End With

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub

Je te remercie énormément. Je regarde ça et je vais faire le pas à pas pour mieux le comprendre.

Je te tiens au courant.

Après avoir contrôlé tout mon fichier et mes 5156 adresses, , je viens vous remercier, en particulier Pedro22. Ton fichier fonctionne très bien. Je me retrouve avec de nombreux doublons mais c'est à moi de trouver les mots qui, comme tu me l'as remarqué, ne fassent pas doublons. Malheureusement, pour certaines adresses, je n'ai pas trop le choix des mots. Du coup, je dois passer en revue toutes les adresses pour enlever ces doublons.

Mais ton programme est génial.

A Bientôt.

ça te permettra au moins de limiter les actions à faire à la main...

Bon courage en tout cas !